Extrahieren von Daten aus CSV-Dateien in eine einzelne excel-Datei

Hier die details zu meiner Frage.

  • Ich habe Tausende von csv-Dateien, die benötigt werden, kombiniert in einem einzigen excel-Datei.
  • Nur bestimmte Daten für jede csv-Datei benötigt werden, extrahiert, A2, G2 und höchsten Wert der H-Zelle.
  • Jede csv-Datei extrahiert wird, werden in neue Arbeitsmappe angeordnet, die durch die Sequenz der Extraktion. (csv-A2->Eine Zelle, csv-G2->B-Zell -, csv -, H->Zelle)

Weil ich Tausende von csv-Dateien ist es möglich, kombiniert alle Daten, indem Sie alle csv-Dateien in einem anderen Ordner?

Vielen Dank für die Aufmerksamkeit.

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

Das Ergebnis der max-Wert immer null zurückgeben. Warum? Wer kann mich korrigieren?

  • Wer kann helfen? Das Gefühl, verloren!
InformationsquelleAutor user1828786 | 2012-11-19
  1. 0

    Nicht positiv, wenn ich vollständig verstanden Ihre Anforderungen zu finden falls dir das hilft.

    Fügen Sie diesen code in ein Modul in einer neuen Arbeitsmappe, und stellen Sie Ihre CSV-Dateien in einem Unterordner namens "CSV". Die Ergebnisse der angezeigt werden soll in Tabelle1 der neuen Arbeitsmappe. Beachten Sie, dass es überprüft nur Dateien mit einer CSV-Datei-Erweiterung. Wenn Sie brauchen, um das zu ändern, betrachten Sie die Zeile 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
    • Vielen Dank für die Antwort. Aber, ich habe das problem extrahieren der höchste Wert in den Spalten H, das Ergebnis zeigt immer null. Das ist mein code, hoffe jemand kann korrigieren, mein Fehler, danke
    InformationsquelleAutor transistor1
Schreibe einen Kommentar