Ich habe zwei sehr große Excel-Dateien mit Finanzdaten. Ich muss die Daten aus einer Datei mit den Daten der anderen kombinieren. Allen Zeilen in der ersten Datei ist ein Kategoriencode zugewiesen. Einige Zeilen in der zweiten Datei haben möglicherweise denselben Code.
Ich muss alle Zeilen aus der ersten Datei mit allen übereinstimmenden Zeilen mit demselben Code aus der zweiten Datei kombinieren. Die Dateien haben eine unterschiedliche Anzahl von Spalten.
Wie soll ich das angehen?
Antwort1
Fügen Sie zunächst der Datei einige Spalten hinzu, die zum Ausrichten der Daten erforderlich sind. Schneiden Sie dann die Daten aus der kleinsten in die größte Datei aus, fügen Sie sie ein und sortieren Sie sie anschließend nach Ihrem Kategoriecode.
Hier ist eine Möglichkeit, dies in VBA zu tun. Dieser Code kopiert nur, wenn die Zelle mit dem NACE-Wert dieselbe ist, aber Sie können ihn Ihren Anforderungen entsprechend ändern. Derzeit kopiert er einfach die gesamte Zeile in die erste Arbeitsmappe.
Private Sub CopyRows()
Dim FirstSheet As Range
Dim SecondSheet As Range
Dim s1col As Integer, s2col As Integer
Dim nextrow As Integer, secondendrow As Integer
Dim copyrow As Range, col As Range
Dim firstsheetrow As Range, secondsheetrow As Range
Dim NACE() As String, Limit As Integer, Index As Integer
Dim testrange As Range
Set FirstSheet = ActiveSheet.UsedRange
Set SecondSheet = Workbooks("Book2").Sheets("Sheet1").UsedRange
For Each col In FirstSheet.Columns
If Not col.Cells(1).Find("NACE") Is Nothing Then
s1col = col.Column
Exit For
End If
Next col
For Each col In SecondSheet.Columns
If Not col.Cells(1).Find("NACE") Is Nothing Then
s2col = col.Column
Exit For
End If
Next col
''//Fill NACE array with distinct entries from first sheet
nextrow = FirstSheet.Rows.Count + 1
ReDim Preserve NACE(1 To 1)
NACE(1) = FirstSheet.Rows(2).Cells(1, s1col).Value
For Each firstsheetrow In FirstSheet.Range("3:" & nextrow - 1).Rows
Limit = UBound(NACE)
If instrArray(NACE, firstsheetrow.Cells(1, s1col).Value) = 0 Then
ReDim Preserve NACE(1 To Limit + 1)
NACE(Limit + 1) = firstsheetrow.Cells(1, s1col).Value
End If
Next firstsheetrow
''//Copy lines from second sheet that match a NACE value on the first sheet
secondendrow = SecondSheet.Rows.Count
For Each secondsheetrow In SecondSheet.Range("2:" & secondendrow).Rows
Index = instrArray(NACE, secondsheetrow.Cells(1, s2col).Value)
If Index > 0 Then
secondsheetrow.Copy
ActiveSheet.Rows(nextrow).PasteSpecial (xlPasteValues)
End If
Next secondsheetrow
End Sub
Dieser Code muss in ein Modul eingefügt werden, um die Hauptroutine zu unterstützen:
Public Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDest As Any, _
pSrc As Any, _
ByVal ByteLen As Long)
Public Function GetArrayDimensions(ByVal arrPtr As Long) As Integer
Dim address As Long
'get the address of the SafeArray structure in memory
CopyMemory address, ByVal arrPtr, ByVal 4
'if there is a dimension, then
'address will point to the memory
'address of the array, otherwise
'the array isn't dimensioned
If address <> 0 Then
'fill the local variable with the first 2
'bytes of the safearray structure. These
'first 2 bytes contain an integer describing
'the number of dimensions
CopyMemory GetArrayDimensions, ByVal address, 2
End If
End Function
Public Function VarPtrArray(arr As Variant) As Long
'Function to get pointer to the array
CopyMemory VarPtrArray, ByVal VarPtr(arr) + 8, ByVal 4
End Function
Function instrArray(strArray, strWanted, _
Optional CaseCrit As Boolean = False, _
Optional FirstOnly As Boolean = True, _
Optional Location As String = "exact") As Long
'
'****************************************************************************************
' Title instrArray
' Target Application: any
' Function: searches string array for some "wanted" text
' Limitations:
' Passed Values:
' strArray [in, string array] array to be searched
' strWanted [in, string] text for which strArray is searched
' CaseCrit [in, Boolean, Optional]
' if true, case (upper/lower) of each character is critical and must match
' if false, case is not critical {default}
' FirstOnly [in, Boolean, Optional]
' if true, proc exits after first instance is found {default}
' if false, proc search to end of array and last instance # is returned
' Location [in, string, Optional] text matching constraint:
' = "any" as long as strWanted is found anywhere in strArray(k),i.e.,
' instr(strArray(k),strWanted) > 0, then instrArray = K
' = "left" match is successful only if
' Left(strArray(K),Len(strWanted) = StrWanted
' = "right" match is successful only if
' Right(strArray(K),Len(strWanted) = StrWanted
' = "exact" match is successful only if
' strArray(K) = StrWanted {default}
'
'****************************************************************************************
'
'
Dim I As Long
Dim Locn As String
Dim strA As String
Dim strB As String
instrArray = 0
Locn = LCase(Location)
Select Case FirstOnly
Case True
For I = LBound(strArray) To UBound(strArray)
Select Case CaseCrit
Case True
strA = strArray(I): strB = strWanted
Case False
strA = LCase(strArray(I)): strB = LCase(strWanted)
End Select
If instrArray2(Locn, strA, strB) > 0 Then
instrArray = I
Exit Function
End If
Next I
Case False
For I = UBound(strArray) To LBound(strArray) Step -1
Select Case CaseCrit
Case True
strA = strArray(I): strB = strWanted
Case False
strA = LCase(strArray(I)): strB = LCase(strWanted)
End Select
If instrArray2(Locn, strA, strB) > 0 Then
instrArray = I
Exit Function
End If
Next I
End Select
End Function
Function instrArray2(Locn, strA, strB)
'
'****************************************************************************************
' Title instrArray2
' Target Application: any
' Function called by instrArray to complete test of strB in strA
' Limitations: NONE
' Passed Values:
' Locn [input, string] text matching constraint (see instrArray)
' strA [input, string] 1st character string
' strB [input, string] 2nd character string
'
'****************************************************************************************
'
'
Select Case Locn
Case "any"
instrArray2 = InStr(strA, strB)
Case "left"
If Left(strA, Len(strB)) = strB Then instrArray2 = 1
Case "right"
If Right(strA, Len(strB)) = strB Then instrArray2 = 1
Case "exact"
If strA = strB Then instrArray2 = 1
Case Else
End Select
End Function
Antwort2
Für diese Art von Aufgabe ist Microsoft Access gedacht und wird als „Left Join“ bezeichnet. Sie können dies jedoch auch in Excel mithilfe einer VLookup-Funktion oder mithilfe der Match- und Index-Funktion tun. Persönlich bevorzuge ich Match/Index.
Angenommen, Blatt1 A:F ist die erste Datei und Sie legen die zweite Datei auf Blatt2 A1:Q500. Nehmen wir an, Ihre Codes befinden sich in Spalte A beider. Geben Sie dann auf Blatt1 in G2 Folgendes ein:
=MATCH(A2,Sheet2!A$1:A$500,0)
Geben Sie dann in H2 ein:
=INDEX(Sheet2!B$1:B$500,$G2)
Ziehen Sie dies dann herüber und ziehen Sie alle nach unten.
Antwort3
Abhängig von der Größe der beiden Dateien können Sie auch versuchen, Abfragen aus Excel-Dateien zu verwenden:
- Definieren Sie einen Namen für die erste Excel-Tabelle (Registerkarte „Formeln“ -> „Namen definieren“)
- Name für zweite Excel-Tabelle festlegen
- Gehen Sie zur Registerkarte „Daten“, wählen Sie „Aus anderen Quellen“ und wählen Sie aus der Dropdown-Liste „Aus Microsoft Query“
- Wählen Sie Ihre Arbeitsmappendatei aus und bestätigen Sie, dass Sie die Spalten manuell zusammenführen möchten.
- Im folgenden Fenster "Abfrage aus Excel-Dateien" ziehen Sie die erste Spalte der ersten Tabelle per Drag&Drop in die erste Spalte der zweiten Tabelle - es entsteht eine Verknüpfung zwischen diesen Spalten
- Gehen Sie zum Menü „Datei“ und klicken Sie auf „Daten an MS Office Excel zurückgeben“. Ein Dialogfeld „Daten importieren“ wird angezeigt.
- Wählen Sie das Blatt aus, in das die übereinstimmenden Daten importiert werden sollen
- Klicken Sie auf OK -> Sie sollten übereinstimmende Daten mit Spalten aus beiden Tabellen sehen