excel - 将多个文本文件中的数据复制到现有工作表中
问题描述
我希望允许用户一次选择最多 5 个文本文件并将数据复制粘贴到 excel 中的现有工作表中。每个文本文件都将添加到前一个文件之后。这意味着如果第一个文件已从 A1 列导入到 A200,则必须从 A201 行粘贴第二个文件,依此类推。我正在使用以下代码,它只允许用户选择一个文件。我希望只是将这些文本文件中的数据复制粘贴到 Excel 中,而不进行任何格式化。任何帮助将不胜感激。
Sub importdata()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
FileToOpen = Application.GetOpenFilename(Title:="Select file extracted", FileFilter:="All Files (*.*),*.*")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
OpenBook.Sheets(1).Range("A:A").Copy
ThisWorkbook.Worksheets("rawdata").Range("A1").PasteSpecial xlPasteValues
OpenBook.Close False
End If
End Sub
解决方案
试试这个:
Option Explicit ' It is a good practice to use this to force the compiler to ask for
' Var declaration before use it
Sub importdata()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim RngCopy As Range ' Var to store the range you want to copy
Dim RngPaste As Range ' Var to store the rante you want paste the txt file data
Dim A As Worksheet ' ActiveSheet of the open book stored in "OpenBook" var
Dim B As Worksheet: Set B = ThisWorkbook.Worksheets("rawdata") '... Well RawData...
Dim r
Dim p
Dim i
FileToOpen = Application.GetOpenFilename( _
Title:="Select file extracted", _
FileFilter:="All Files (*.*),*.*", _
MultiSelect:=True)
'As mention Ron Rosenfeld, you need to use Multiselect
'Since you want several files, you need a LOOP, a For Loop!
For Each i In FileToOpen ' no matter if is 1 or many files you take, will work
If FileToOpen = "False" Then Exit Sub 'But if you take no files will exit with no error
'If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen) 'the macro open the file
Set A = OpenBook.ActiveSheet 'Store the active sheet inside A
r = A.Range("A1").SpecialCells(xlCellTypeLastCell).Row 'Here look for the last cell, this is like
' press the CTRL+END keys in the keyboard
'I asume your data in only en column A
'goto to the last cell and take the number of the row
Set RngCopy = A.Range(Cells(1, 1), Cells(r, 1)) 'Take the whole range, and I asume you want to take
'From A1 to the last row, A1000 ej.
'OpenBook.Sheets(1).Range("A:A").Copy
B.Activate 'Go to rawdata!
p = B.Range("A1000000").End(xlUp).Row + 1 'Here! From the very last cell.
'Notice: if you have Excel 97 and before, you need to change to
'65000, if not, 1000000 will work.
'From the A1000000 to the top, tell the row + 1
'Mean... one row bellow the last row in your data.
Set RngPaste = B.Range(Cells(p, 1), Cells(p + r, 1)) 'Look Here!
'The last cell (last row + 1 = p) of your data in rawData plus
'The data you want to insert bellow that data.
'p + the count of the rows in the new data (r)
'p + r
'all this just in column A
RngPaste.Value = RngCopy.Value
'We don't use COPY, only if is necesary!
'We transfer data from here to there!
'Now we can tell B = A
'B.Range("A1").PasteSpecial xlPasteValues
OpenBook.Close False 'Good Boy!!!
'it is good practice to clean your vars/objects
Set OpenBook = Nothing
Set A = Nothing
Set B = Nothing
Set RngCopy = Nothing
Set RngPaste = Nothing
'End If
Next i
End Sub
告诉我是否正确,编辑和修复任何内容。
推荐阅读
- azure - Azure Functions 核心工具安装卡在 Visual Studio 代码中
- mysql - MYSQL - 添加列并计算日期的逾期天数并按最长延迟排序
- javascript - 更改数据库php中的直接输入选择?
- android - 无法创建虚拟设备
- c - 在代码中使用输入 txt 文件作为用户 C 语言的模拟输入
- c++ - 在makefile中找不到.so library -l
- c++ - 如何避免或抑制此无锁堆栈中的竞争?
- python - nltk.TweetTokenizer 与 nltk.word_tokenize 有何不同?
- android - 使用 Android 应用程序在后台编码音乐流
- java - 尝试在 Spring-boot 中使用 Jackson 将 json 数组反序列化为 java String