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

将CSV文件中的数据提取到单个excel文件中

1 个答案: