在一个Excel表单中合并多个CSV文件 [英] Merge multiple csv files in one excel sheet

查看:396
本文介绍了在一个Excel表单中合并多个CSV文件的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

在互联网上搜索了很多,我试图结合一个工作的Excel VBA代码,读取文件夹中的所有.csv文件到Excel文件(每个在一个单独的工作表上)。
但我唯一需要的是结合所有的csv文件在1个工作表....



工作代码是:






将工作文件复制到单独的工作表中



  Sub Example12()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles()As String
Dim SourceRcount As Long
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook

'在您的机器上填入路径\folder中的文件
'
MyPath =c:\数据

如果用户忘记则在末尾添加斜杠
如果Right(MyPath,1)<> \then
MyPath = MyPath& \
如果

结束如果文件夹中没有Excel文件退出sub
FilesInPath = Dir(MyPath&* .csv)
如果FilesInPath =那么
MsgBox没有找到文件
退出子
结束如果

出现错误GoTo CleanUp

Application.ScreenUpdating = False
设置basebook = ThisWorkbook

'使用文件夹中的Excel文件列表填充数组(myFiles)
Fnum = 0
Do While FilesInPath<>
Fnum = Fnum + 1
ReDim保存MyFiles(1到Fnum)
MyFiles(Fnum)= FilesInPath
FilesInPath = Dir()
Loop

'遍历数组中的所有文件(myFiles)
如果Fnum> 0 Then
For Fnum = LBound(MyFiles)To UBound(MyFiles)
设置mybook = Workbooks.Open(MyPath& MyFiles(Fnum))
mybook.Worksheets(1) := _
basebook.Sheets(basebook.Sheets.Count)

错误恢复下一个
ActiveSheet.Name = mybook.Name
错误时转到0

'如果您只想复制值
',您可以使用此方法
'With ActiveSheet.UsedRange
'.Value = .Value
'End With

mybook.Close savechanges:= False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End Sub
--- -------------------------------------------------- ----

但是我所做的改变是改变了VBA将其复制到最后一个之后的片段,以将它附加到现有的表Totaal。






 工作代码
-------------------------------------------- -------------

Sub Example12()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles()As String
Dim SourceRcount As Long
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook

'填写路径\folder其中文件是
'在您的机器上
MyPath =c:\Data

如果用户忘记,在末尾添加一个斜杠
如果右(MyPath,1)<> \then
MyPath = MyPath& \
如果

结束如果文件夹中没有Excel文件退出sub
FilesInPath = Dir(MyPath&* .csv)
如果FilesInPath =那么
MsgBox没有找到文件
退出子
结束如果

出现错误GoTo CleanUp

Application.ScreenUpdating = False
设置basebook = ThisWorkbook

'使用文件夹中的Excel文件列表填充数组(myFiles)
Fnum = 0
Do While FilesInPath<>
Fnum = Fnum + 1
ReDim保存MyFiles(1到Fnum)
MyFiles(Fnum)= FilesInPath
FilesInPath = Dir()
Loop

'遍历数组中的所有文件(myFiles)
如果Fnum> 0 Then
For Fnum = LBound(MyFiles)To UBound(MyFiles)
设置mybook = Workbooks.Open(MyPath& MyFiles(Fnum))
mybook.Worksheets(1).Copy

** basebook.Sheets(Totaal)。选择
NextRow = Cells(Rows.Count,0).End(xlUp).Row
Cells(NextRow,1) .Select
ActiveSheet.Paste **

出现错误时恢复下一个
ActiveSheet.Name = mybook.Name
出现错误GoTo 0

'你可以使用这个,如果你只需要复制的值
'With ActiveSheet.UsedRange.Value = .Value
'End With

mybook.Close savechanges:= False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End Sub






我没有知道更改这个:(。
我在正确的轨道上吗?



所有输入都将非常感谢!



额外信息:CSV文件中的数据放在第一列。



谢谢!

解决方案

之后设置basebook = ThisWorkbook



输入:

  Dim nextRow As Integer 
Dim wsTotal as工作表
设置wsTotal = basebook.Worksheets(Total)

以下是更正后的For循环:

 '遍历数组中的所有文件(myFiles)
如果Fnum> 0然后
For Fnum = LBound(MyFiles)到UBound(MyFiles)

'打开文件
设置mybook = Workbooks.Open(MyPath& MyFiles(Fnum))

使用wsTotal

如果需要,可以激活(可选)
'。激活

'复制表单上的所有数据
mybook.Worksheets(1).UsedRange.Copy

查找下一个空行
nextRow = .Range(A1)。SpecialCells(xlCellTypeLastCell).Row + 1

如果需要,选择(可选)
'.Cells(NextRow,1)。选择

'粘贴数据
.Cells(nextRow,1)。 PasteSpecial(xlPasteAll)

关闭复制模式
Application.CutCopyMode = False

'你真的要更改工作表名称吗?
.Name = mybook.Name
结束于

'关闭文件
mybook.Close savechanges:= False

下一个Fnum


After searching a lot on the internet i tried to combine a working Excel VBA code that reads all .csv files in a folder into an excel file (each on a seperate worksheet). But the only thing i need is to combine all the csv files in 1 worksheet....

The working code is:


working file into seperate worksheets

Sub Example12()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook

'Fill in the path\folder where the files are
'on your machine
MyPath = "c:\Data"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.csv")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

On Error GoTo CleanUp

Application.ScreenUpdating = False
Set basebook = ThisWorkbook

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
mybook.Worksheets(1).Copy after:= _
basebook.Sheets(basebook.Sheets.Count)

On Error Resume Next
ActiveSheet.Name = mybook.Name
On Error GoTo 0

' You can use this if you want to copy only the values
' With ActiveSheet.UsedRange
' .Value = .Value
' End With

mybook.Close savechanges:=False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End Sub
---------------------------------------------------------

But the change i've made was to change the part where the VBA copies it into a sheet "after" the last one, to append it to a existing sheet "Totaal".


not working code
---------------------------------------------------------

Sub Example12()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook

'Fill in the path\folder where the files are
'on your machine
MyPath = "c:\Data"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.csv")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

On Error GoTo CleanUp

Application.ScreenUpdating = False
Set basebook = ThisWorkbook

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
mybook.Worksheets(1).Copy

**basebook.Sheets("Totaal").Select
NextRow = Cells(Rows.Count, 0).End(xlUp).Row
Cells(NextRow, 1).Select
ActiveSheet.Paste**

On Error Resume Next
ActiveSheet.Name = mybook.Name
On Error GoTo 0

' You can use this if you want to copy only the values
' With ActiveSheet.UsedRange.Value = .Value
' End With

mybook.Close savechanges:=False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End Sub


I haven't got the knowledge to change this :(. Was I on the right track?

All input will be greatly appreciated!

EXTRA INFO: The data in the CSV files are put in the first column. After the whole merging process i planned to do the split into columns afterwards....

Thanks!

解决方案

After Set basebook = ThisWorkbook

Enter this:

Dim nextRow As Integer
Dim wsTotal As Worksheet
Set wsTotal = basebook.Worksheets("Total")

And here is the corrected For loop:

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
    For Fnum = LBound(MyFiles) To UBound(MyFiles)

        'open file
        Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))

        With wsTotal

            'activate if you want (optional)
            '.Activate

            'copy all the data on the sheet
            mybook.Worksheets(1).UsedRange.Copy

            'find the next empty row
            nextRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1

            'select if desired (optional)
            '.Cells(NextRow, 1).Select

            'paste the data
            .Cells(nextRow, 1).PasteSpecial (xlPasteAll)

            'turn off copy mode
            Application.CutCopyMode = False

            'Do you really want to change the worksheet name?
            .Name = mybook.Name
        End With

        'close file
        mybook.Close savechanges:=False

    Next Fnum

这篇关于在一个Excel表单中合并多个CSV文件的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆