将 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