將 CSV 文件中的數據提取到單個 Excel 文件中

Question

這是我的問題的詳細信息。

• 我有數千個 csv 文件需要合並到一個 excel 文件中。
• 只需要提取每個csv文件的某些數據，A2、G2和H單元格的最高值。
• 提取的每個 csv 文件都將在按提取順序排列的新工作簿中。 (csv A2->A 單元格、csv G2->B 單元格、csv H->單元格)

因為我有數千個 csv 文件，是否可以通過選擇不同文件夾中的所有 csv 文件來合並所有數據？

非常感謝您的關注。

Option Explicit

Function ImportData()

Dim wkbCrntWorkBook As Workbook
Dim wkbSourceBook   As Workbook
Dim rngSourceRange1  As Range
Dim rngSourceRange2 As Range
Dim rngSourceRange3 As Range
Dim rngDestination1  As Range
Dim rngDestination2  As Range
Dim rngDestination3 As Range
Dim intColumnCount  As Integer

Dim YesOrNoAnswerToMessageBox As String
Dim QuestionToMessageBox As String

Set wkbCrntWorkBook = ActiveWorkbook

Dim SelectedItemNumber As Integer

Dim HighestValueRng As Range
Dim Highest As Double

Do

SelectedItemNumber = SelectedItemNumber + 1

With Application.FileDialog(msoFileDialogOpen)
    .Filters.Clear
    .Filters.Add "Excel 2007", "*.xlsx; *.xlsm; *.xlsa", 1
    .Filters.Add "Excel 2002-03", "*.xls", 2
    .Filters.Add "Command Separated Values", "*.csv", 3
    .AllowMultiSelect = True
    .Show

For SelectedItemNumber = 1 To .SelectedItems.Count

    If .SelectedItems.Count > 0 Then
        Workbooks.Open .SelectedItems(SelectedItemNumber)
        Set wkbSourceBook = ActiveWorkbook
        Set rngSourceRange1 = ActiveCell.Offset(1, 0)
        Set rngSourceRange2 = ActiveCell.Offset(1, 6)


        wkbCrntWorkBook.Activate

        Set rngDestination1 = ActiveCell.Offset(1, 0)
        Set rngDestination2 = ActiveCell.Offset(1, 1)

        ActiveCell.Offset(1, 2).Value = Application.WorksheetFunction.Max(Columns("H"))

        For intColumnCount = 1 To rngSourceRange1.Columns.Count

            If intColumnCount = 1 Then
                rngSourceRange1.Columns(intColumnCount).Copy rngDestination1
            Else
                rngSourceRange1.Columns(intColumnCount).Copy rngDestination1.End(xlDown).End(xlDown).End(xlUp).Offset(1)
            End If
        Next

        For intColumnCount = 1 To rngSourceRange2.Columns.Count

            If intColumnCount = 1 Then
                rngSourceRange2.Columns(intColumnCount).Copy rngDestination2
            Else
                rngSourceRange2.Columns(intColumnCount).Copy rngDestination2.End(xlDown).End(xlDown).End(xlUp).Offset(1)
            End If
        Next

        ActiveCell.Offset(1, 0).Select

        wkbSourceBook.Close False
    End If

Next SelectedItemNumber

End With

YesOrNoAnswerToMessageBox = MsgBox("Continue?", vbYesNo)

Loop While YesOrNoAnswerToMessageBox = vbYes


Set wkbCrntWorkBook = Nothing
Set wkbSourceBook = Nothing
Set rngSourceRange1 = Nothing
Set rngSourceRange2 = Nothing
Set rngDestination1 = Nothing
Set rngDestination2 = Nothing
intColumnCount = Empty

End Function

最大值的結果總是返回零。 為什么？ 任何人都可以糾正我嗎？

Answer 1

如果我完全理解您的要求，那不是肯定的，但請看看這是否對您有幫助。

將此代碼粘貼到新工作簿的模塊中，然后將 CSV 文件放入名為“CSV”的子文件夾中。 結果應出現在新工作簿的 Sheet1 中。 請注意，它只會檢查具有 CSV 文件擴展名的文件。 如果您需要更改它，請查看If Right(file.Name, 3) = "csv"

Sub ParseCSVs()
    Dim CSVPath
    Dim FS
    Dim file
    Dim wkb As Excel.Workbook
    Dim ResultsSheet As Worksheet
    Dim RowPtr As Range
    Dim CSVUsed As Range

    Set ResultsSheet = Sheet1

    'Clear the results sheet
    ResultsSheet.Cells.Delete

    Set FS = CreateObject("Scripting.FileSystemObject")

    'The CSV files are stored in a "CSV" subfolder of the folder where
    'this workbook is stored.
    CSVPath = ThisWorkbook.Path & "\CSV"

    If Not FS.FolderExists(CSVPath) Then
        MsgBox "CSV folder does not exist."
        Exit Sub
    End If

    ResultsSheet.Range("A1:D1").Value = Array("CSV A2", "CSV G2", "CSV Max of H", "File")
    ResultsSheet.Range("A1").EntireRow.Font.Bold = True
    Set RowPtr = ResultsSheet.Range("A2")
    For Each file In FS.GetFolder(CSVPath).Files
        If Right(file.Name, 3) = "csv" Then 'Only look at files with .csv extension
            Set wkb = Application.Workbooks.Open(file.Path)
            Set CSVUsed = wkb.Sheets(1).UsedRange

            RowPtr.Range("A1") = CSVUsed.Range("A2")
            RowPtr.Range("B1") = CSVUsed.Range("G2")
            RowPtr.Range("C1") = Application.WorksheetFunction.Max(CSVUsed.Range("H:H"))
            RowPtr.Range("D1") = file.Name

            wkb.Close False

            Set RowPtr = RowPtr.Offset(1)
        End If
    Next

    ResultsSheet.Range("A:D").EntireColumn.AutoFit
End Sub