Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/27.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel 将多个文本文件中的数据复制到现有图纸中_Excel_Vba_Import_User Input - Fatal编程技术网

Excel 将多个文本文件中的数据复制到现有图纸中

Excel 将多个文本文件中的数据复制到现有图纸中,excel,vba,import,user-input,Excel,Vba,Import,User Input,我希望允许用户一次最多选择5个文本文件,并将数据复制粘贴到excel中的现有工作表中。每个文本文件都将添加到上一个文件之后。这意味着,如果第一个文件已从列A1导入到A200,则第二个文件必须从行A201粘贴,依此类推。我使用下面的代码,允许用户只选择一个文件。我希望只复制粘贴数据从这些文本文件到excel没有任何格式。任何帮助都将不胜感激 Sub importdata() Dim FileToOpen As Variant Dim OpenBook As Workbook FileTo

我希望允许用户一次最多选择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

子导入数据()
Dim FileToOpen作为变体
将OpenBook设置为工作簿
FileToOpen=Application.GetOpenFilename(标题:=“选择提取的文件”,文件过滤器:=“所有文件(*.*),***”)
如果FileToOpen为False,则
设置OpenBook=Application.Workbooks.Open(FileToOpen)
OpenBook.Sheets(1).范围(“A:A”).副本
此工作簿.工作表(“rawdata”).范围(“A1”).粘贴特殊XLPaste值
打开书本,关闭错误
如果结束
端接头
尝试一下:

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
Option Explicit'使用此选项强制编译器请求
'Var声明,然后再使用它
子导入数据()
Dim FileToOpen作为变体
将OpenBook设置为工作簿
Dim RngCopy As Range'Var以存储要复制的范围
Dim RngPaste As Range“Var以存储要粘贴txt文件数据的rante
将存储在“OpenBook”变量中的打开的书本的“作为工作表”活动页调暗
将B标注为工作表:设置B=此工作簿。工作表(“原始数据”)。。。嗯,原始数据。。。
暗r
暗p
昏暗的我
FileToOpen=Application.GetOpenFilename(_
标题:=“选择已提取的文件”_
FileFilter:=“所有文件(*.*),***”_
多选:=真)
正如罗恩·罗森菲尔德所说,你需要使用Multiselect
'因为您需要几个文件,所以需要一个循环,一个For循环!
对于文件中的每个i打开“无论是1个文件还是多个文件,都可以工作
如果FileToOpen=“False”则退出Sub”,但如果您没有获取任何文件,则将无错误地退出
'如果FileToOpen为False,则
设置OpenBook=Application.Workbooks.Open(FileToOpen)'宏打开文件
设置A=OpenBook.ActiveSheet'将活动工作表存储在
r=A.Range(“A1”).SpecialCells(xlCellTypeLastCell)。行“在此处查找最后一个单元格,如下所示
'按键盘上的CTRL+END键
“我只在A列中计算您的数据
'转到最后一个单元格并获取行的编号
设置RngCopy=A.Range(单元格(1,1),单元格(r,1))'获取整个范围,然后我确定要获取的值
'从A1到最后一行,A1000 ej。
“OpenBook.Sheets(1).范围(“A:A”).副本
B.激活“转到原始数据!”!
p=B.范围(“A1000000”)。结束(xlUp)。此处第+1行!从最后一个牢房。
'注意:如果您有Excel 97及以前的版本,则需要更改为
“65000,如果不是,1000000将起作用。
'从A100000到顶部,告诉行+1
“我的意思是。。。数据中最后一行下方的一行。
设置rngpast=B.Range(单元格(p,1),单元格(p+r,1))'看这里!
'rawData plus中数据的最后一个单元格(最后一行+1=p)
'要插入的数据位于该数据下方。
'p+新数据中的行数(r)
“p+r
“所有这些都在A栏中
RngPaste.Value=RngCopy.Value
“只有在必要时,我们才使用副本!
“我们将数据从这里传输到那里!
“现在我们可以知道B=A
'B.范围(“A1”).粘贴特殊XLPaste值
打开书本。关闭假“好孩子”!!!
“清洁VAR/对象是一种很好的做法
设置OpenBook=Nothing
设置A=无
设置B=无
设置RngCopy=Nothing
设置RngPaste=Nothing
"完"
接下来我
端接头

告诉我是否正确,编辑并修复任何内容。

使用
MultiSelect
参数实现
GetOpenFilename
函数。非常感谢Elbert!我不得不根据我的文件名等做一些小的调整。但除此之外,它是有效的。非常感谢你@埃尔伯特