从CSV文件中提取数据到一个excel文件中

这是我的问题的细节。

• 我有成千上万的CSV文件需要合并在一个Excel文件。
• 只需要提取每个csv文件的某些数据，A2，G2和H cell的最高值。
• 每个提取的csv文件都将按照提取顺序排列在新的工作簿中。 （csv A2-> A细胞，csv G2-> B细胞，csv H->细胞）

因为我有成千上万的csv文件，是否可以通过select不同文件夹中的所有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