按照条件将多个CSV文件合并成一个Excel文件

若木紫兰

看不懂啊，复制粘贴之后不好用，没反应啊！

huhaizhu

谢谢分享 学习学习

夜惊风

非常有用，3Q！

guyingdabendan

zldccmx 发表于 2008-10-29 22:19
这是附件，以及汇总效果!
请楼主验收!

求救!

我有个问题, 我要把很多csv 文件全部汇总到excel中,但是汇总后csv的格式没有能够转换,所有的数据都在每行的第一格中.
我用了code:Sub zldccmx()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim WK As Workbook, CSV As Workbook, MyPath$, MyName$
    MyPath = ThisWorkbook.Path & "\csv\"
    MyName = Dir(MyPath & "*.csv")
    If MyName <> "" Then Set WK = ThisWorkbook Else Exit Sub
    For Each sh In WK.Worksheets
        If sh.Name <> "Sheet1" Then sh.Delete
    Next
    Do While MyName <> ""    ' 开始循环。
        Set CSV = Workbooks.Open(MyPath & MyName): WK.Sheets.Add
        WK.ActiveSheet.Name = Split(MyName, ".")(0)
        With CSV.ActiveSheet
            ro = .UsedRange.Rows.Count
            co = .UsedRange.Columns.Count
            .Cells(1, co + 1).Resize(ro, 1) = "=if(RC[-" & co & "]=""b"",0,1/0)"
            .Columns(co + 1).SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
            .Columns(co + 1) = ""
            .UsedRange.Copy WK.ActiveSheet.[A1]
            CSV.Close False
        End With
        MyName = Dir
    Loop
    WK.Save    'As MyPath & "aaa.xls" 请教.zip (723.78 KB, 下载次数: 2)

2014-11-12 18:48 上传

点击文件名下载附件
csv to xlsx

    MsgBox MyPath & "下所有的CSV文件 均已经汇总到工作簿" & WK.Name & "中!" & vbLf & vbLf & "汇总完成，现在退出!"
    Application.EnableEvents = True
End Sub




我的没有能够成功.因为我是新手,有的程序都不了解是什么意思.

能不能帮我看下,内容在附件中.(将几个格式相同的csv汇总到一个excel 中)

ykcbf1100

老题新解。

纯练手。。。

ykcbf1100

纯练手。。。

1. Sub ykcbf()  '//2024.5.2
   
2.     Set fso = CreateObject("scripting.filesystemobject")
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     Set ws = ThisWorkbook
   
6.     Set sh = ws.Sheets("操作台")
   
7.     p = ThisWorkbook.Path & "\csv"
   
8.     ReDim brr(1 To 10000, 1 To 10)
   
9.     For Each sht In Sheets
   
10.         If sht.Name <> sh.Name Then sht.Delete
    
11.     Next
    
12.     For Each f In fso.GetFolder(p).Files
    
13.         If f.Name Like "*.csv" Then
    
14.             fn = fso.GetBaseName(f)
    
15.             m = 0
    
16.             Set wb = Workbooks.Open(f, 0)
    
17.             With wb.Sheets(1)
    
18.                 arr = .UsedRange
    
19.                 wb.Close False
    
20.             End With
    
21.             For i = 1 To UBound(arr)
    
22.                 If arr(i, 1) = "b" Then
    
23.                     m = m + 1
    
24.                     For j = 1 To UBound(arr, 2)
    
25.                         brr(m, j) = arr(i, j)
    
26.                     Next
    
27.                 End If
    
28.             Next
    
29.             Set sht = ws.Sheets.Add(After:=ws.Sheets(ws.Sheets.Count))
    
30.             With sht
    
31.                 .Name = fn
    
32.                 .[a1].Resize(m, 10) = brr
    
33.             End With
    
34.         End If
    
35.     Next f
    
36.     Application.ScreenUpdating = True
    
37.     MsgBox "OK！"
    
38. End Sub
    

复制代码