Question

谁可以帮助这个宏？它将csv文件合并为一个。 csv文件可能超过500并且运行缓慢。顺便说一句，它在csv文件中放置所有数据（2行）。如果宏可以从文件中获取第二行，它将适用于我。

有什么想法吗？

Option Explicit

Sub ImportCSV65()

Dim strSourcePath As String
Dim strDestPath As String
Dim strFile As String
Dim strData As String
Dim x As Variant
Dim Cnt As Long
Dim r As Long
Dim c As Long

Application.Calculation = xlCalculationManual

Application.ScreenUpdating = False

'Change the path to the source folder accordingly
strSourcePath = Worksheets("Tarpinis").Range("AJ8").Value

If Right(strSourcePath, 1) <> "\" Then strSourcePath = strSourcePath & "\"

strFile = Dir(strSourcePath & "*.csv")
Sheets("+65").Select

Application.ScreenUpdating = False
Do While Len(strFile) > 0
    Cnt = Cnt + 1
    If Cnt = 1 Then
        r = 1
    Else
        r = Cells(Rows.Count, "A").End(xlUp).Row + 1
    End If
    Open strSourcePath & strFile For Input As #1
        If Cnt > 1 Then
            Line Input #1, strData
        End If
        Do Until EOF(1)
            Line Input #1, strData
            x = Split(strData, ",")
            For c = 0 To UBound(x)
                Cells(r, c + 1).Value = Trim(x(c))
            Next c
            r = r + 1
        Loop
    Close #1
    Name strSourcePath & strFile As strSourcePath & strFile
    strFile = Dir
Loop

Application.ScreenUpdating = True

If Cnt = 0 Then _
 MsgBox "No CSV files were found...", vbExclamation

Application.ScreenUpdating = False
End Sub

Answer 1

我能看到的唯一可以做得更好的地方是将修剪后的值写入单元格的循环。

如果你必须修剪每个值，那么你仍然需要循环遍历数组并For c = 0 To UBound(x) x(c) = Trim(x(c)) Next c：

Cells(r, 1).Resize(1, UBound(x) + 1).Value = x

但要写入单元格，可以通过将数组直接写入范围来加快速度：

With

您可能还会通过限定目标表获得一点时间，最好是Sub ImportCSV65() Dim strSourcePath As String Dim strDestPath As String Dim strFile As String Dim strData As String Dim x As Variant Dim Cnt As Long Dim r As Long Dim c As Long Application.Calculation = xlCalculationManual Application.ScreenUpdating = False 'Change the path to the source folder accordingly strSourcePath = Worksheets("Tarpinis").Range("AJ8").Value If Right(strSourcePath, 1) <> "\" Then strSourcePath = strSourcePath & "\" strFile = Dir(strSourcePath & "*.csv") With Sheets("+65") .Select Application.ScreenUpdating = False Do While Len(strFile) > 0 Cnt = Cnt + 1 If Cnt = 1 Then r = 1 Else r = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 End If Open strSourcePath & strFile For Input As #1 If Cnt > 1 Then Line Input #1, strData End If Do Until EOF(1) Line Input #1, strData x = Split(strData, ",") For c = 0 To UBound(x) x(c) = Trim(x(c)) Next c .Cells(r, 1).Resize(1, UBound(x) + 1).Value = x r = r + 1 Loop Close #1 Name strSourcePath & strFile As strSourcePath & strFile strFile = Dir Loop End With Application.ScreenUpdating = True If Cnt = 0 Then _ MsgBox "No CSV files were found...", vbExclamation Application.ScreenUpdating = False End Sub。

所以整件事情看起来像这样：

{{1}}

Answer 2

以下内容如下，它将读取给定文件夹中每个CSV文件的第二行，并在Sheet +65中写入该行：

Option Explicit
Sub ImportCSV65()
Dim strSourcePath As String
Dim strDestPath As String
Dim strFile As String
Dim strData As String
Dim x As Variant
Dim Cnt As Long
Dim r As Long
Dim c As Long
Dim counter As Long
Dim ws As Worksheet: Set ws = Sheets("+65")

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
counter = 0
'Change the path to the source folder accordingly
strSourcePath = Worksheets("Tarpinis").Range("AJ8").Value

If Right(strSourcePath, 1) <> "\" Then strSourcePath = strSourcePath & "\"

strFile = Dir(strSourcePath & "*.csv")

Do While Len(strFile) > 0

    Open strSourcePath & strFile For Input As #1

        Do Until EOF(1)
            Line Input #1, strData
            r = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
            counter = counter + 1
                If counter = 2 Then 'counter to get only second line
                x = Split(strData, ",")
                    For c = 0 To UBound(x)
                        ws.Cells(r, c + 1).Value = Trim(x(c))
                    Next c
                    r = r + 1
                    Exit Do
                End If
        Loop
    Close #1
    Name strSourcePath & strFile As strSourcePath & strFile
    strFile = Dir
    counter = 0 'reset counter before next file
Loop

Application.ScreenUpdating = True
End Sub

Answer 3

Workbooks.Open文件名：= strSourcePath＆amp; strFile，格式：= 2 此代码将以excel类型打开csv文件。并将数据作为变体值，并按变量值填充表单。

Sub ImportCSV65()

    Dim strSourcePath As String
    Dim strDestPath As String
    Dim strFile As String
    Dim strData As String
    Dim Ws As Worksheet, rngT As Range

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    'Change the path to the source folder accordingly
    strSourcePath = Worksheets("Tarpinis").Range("AJ8").Value

    If Right(strSourcePath, 1) <> "\" Then strSourcePath = strSourcePath & "\"

    strFile = Dir(strSourcePath & "*.csv")
    Set Ws = Sheets("+65")

    Application.ScreenUpdating = False
    With Ws
        Do While Len(strFile) > 0
            Workbooks.Open Filename:=strSourcePath & strFile, Format:=2
            With ActiveWorkbook.ActiveSheet
                vDB = .UsedRange
            End With
            ActiveWorkbook.Close
            Set rngT = .Range("a" & Rows.Count).End(xlUp)(2)
            rngT.Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB
            strFile = Dir
        Loop
    End With
    Application.ScreenUpdating = False
End Sub

修改宏以使其运行更快

3 个答案: