使用宏将大量的CSV文件合并在一个Excel

laiwandefeng · 发表于 2011-11-7 21:32

请求高手帮忙把大量的格式相同的csv文件合并在一个Excel表格里。谢谢了
请参考附件中的CSV文件。

zhaogang1960 · 发表于 2011-11-7 22:29

请测试
Sub Macro1()
Dim f$, s() As String, a, arr(1 To 60000, 20), i&, j&, m&
f = Dir(ThisWorkbook.Path & "\*.csv")
While f > ""
      Open ThisWorkbook.Path & "\" & f For Input As #1
      s = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
      Close #1
      m = m + 1
      For i = 1 To UBound(s)
         a = Split(s(i), ",")
         For j = 0 To 20
            arr(m, j) = a(j)
         Next
      Next
      f = Dir()
Wend
ActiveSheet.UsedRange.Offset(1).ClearContents
[a2].Resize(m, 21) = arr
End Sub

zhaogang1960 · 发表于 2011-11-7 22:31

请看附件

新建 WinRAR 压缩文件.rar (10.02 KB, 下载次数: 150)

jiminyanyan · 发表于 2011-11-7 23:03

StrConv(InputB(LOF(1), 1), vbUnicode 这个有点复杂，给个注释，学习一下
-------------------------------------------------------------
l = LOF(1) '返回打开文件的总字节数
s = InputB(l, #1) '一次读取整个文件到字节数组
strtmp = StrConv(s, vbUnicode) '将字节数组转换为Unicode字符

zhaogang1960 · 发表于 2011-11-7 23:34

使用SQL方法应该更方便些，但附件中的csv文件有点奇特，用SQL方法不能提取数据

请楼主说一下这些csv文件是从软件中导出来的？还是手工填写的？

榴莲~ · 发表于 2011-11-7 23:52

zhaogang1960 发表于 2011-11-7 23:34
使用SQL方法应该更方便些，但附件中的csv文件有点奇特，用SQL方法不能提取数据

请楼主说一下这些csv文件 ...

新建文件夹.zip (20.99 KB, 下载次数: 25)

我这个问题和他差不多,但我想把要合并的向后串一列,但用老师的宏,我试着改了可是不对,请老师帮看看好吗?

zhaogang1960 · 发表于 2011-11-8 00:43

榴莲~ 发表于 2011-11-7 23:52
我这个问题和他差不多,但我想把要合并的向后串一列,但用老师的宏,我试着改了可是不对,请老师帮看看好 ...

附件中的csv文件也挺奇特，另存为csv文件后就可以了：
Sub Macro1()
   Dim f$, s() As String, a, arr(1 To 60000, 1 To 15), i&, j&, m&
   f = Dir(ThisWorkbook.Path & "\*.csv")
   While f > ""
      t = Replace(f, ".csv", "")
      Open ThisWorkbook.Path & "\" & f For Input As #1
      s = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
      Close #1
      For i = 1 To UBound(s)
         m = m + 1
         arr(m, 1) = t
         a = Split(s(i), ",")
         For j = 0 To UBound(a)
            arr(m, j + 2) = a(j)
         Next
      Next
      f = Dir()
Wend
ActiveSheet.UsedRange.Offset(1).ClearContents
[a2].Resize(m, 15) = arr
End Sub

Sub Macro2() 'SQL法
Dim cnn As Object, SQL$, myPath$, MyFile$
Set cnn = CreateObject("adodb.connection")
Application.ScreenUpdating = False
myPath = ThisWorkbook.Path & "\"
MyFile = Dir(myPath & "*.csv")
Do While MyFile <> ""
   If SQL = "" Then SQL = "select '" & Replace(MyFile, ".csv", "") & "' as 台区编号,* from " & MyFile Else SQL = SQL & " union all select '" & Replace(MyFile, ".csv", "") & "' as 台区编号,* from " & MyFile
      MyFile = Dir()
Loop
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='text;FMT=DELIMITED';Data Source=" & myPath
ActiveSheet.UsedRange.Offset(1).ClearContents
Range("a2").CopyFromRecordset cnn.Execute(SQL)
cnn.Close
Set cnn = Nothing
End Sub

zhaogang1960 · 发表于 2011-11-8 01:06

对于不规则的csv文件还是用打开方式处理吧：
Sub Macro3()
Dim p$, f$, sh As Worksheet
Set sh = ActiveSheet
Application.ScreenUpdating = False
sh.UsedRange.Offset(1).ClearContents
p = ThisWorkbook.Path & "\"
f = Dir(p & "*.csv")
While f > ""
   With GetObject(p & f)
         sh.Range("a65536").End(3).Offset(1).Resize(.ActiveSheet.[a1].CurrentRegion.Rows.Count - 1) = Replace(f, ".csv", "")
         .ActiveSheet.[a1].CurrentRegion.Offset(1).Copy sh.Range("b65536").End(3).Offset(1)
         .Close False
   End With
   f = Dir()
Wend
Application.ScreenUpdating = True
End Sub

laiwandefeng · 发表于 2011-11-8 22:25

o ,是由软件自动导出为csv格式的文件。
谢谢各位的热情帮忙。

川浪子 · 发表于 2012-9-12 21:06

zhaogang1960 发表于 2011-11-7 22:31
请看附件

能不能请你帮我编一个CSV格式合并文件

27.rar (54.21 KB, 下载次数: 13)

		自动登录	找回密码
密码			免费注册

[求助] 使用宏将大量的CSV文件合并在一个Excel