如何合併兩個不同結構的Excel檔案中的資料?

如何合併兩個不同結構的Excel檔案中的資料?

我有兩個非常大的 Excel 文件,其中包含財務資料。我需要將一個文件中的資料與另一個文件中的資料合併。第一個檔案中的所有行都分配有類別代碼。第二個文件中的某些行可能具有相同的程式碼。
我需要將第一個文件中的所有行與第二個文件中具有相同代碼的所有匹配行組合起來。這些文件具有不同的列數。

我該如何解決這個問題?

答案1

首先,在需要排列資料的文件中添加一些列,然後將資料從最小的文件剪下並貼上到最大的文件,然後按類別代碼排序。

這是在 VBA 中執行此操作的一種方法。只有當保存 NACE 值的儲存格相同時,此程式碼才會複製,但您可以根據需要進行修改。現在它只是將整行複製到第一個工作簿。

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

這段程式碼需要進入一個模組來支援主例程:

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

找到實用程式程式碼這裡這裡

答案2

這種任務正是 microsoft access 的用途,稱為「Left Join」。但您仍然可以在 Excel 中使用 vlookup 或使用匹配和索引函數來執行此操作。我個人更喜歡匹配/索引。

假設 Sheet1 A:F 是第一個文件,您將第二個文件放在 Sheet2 A1:Q500 上。假設您的程式碼位於兩者的 A 欄中。然後在 G2 的sheet1上輸入:

=MATCH(A2,Sheet2!A$1:A$500,0)

然後在 H2 中輸入:

=INDEX(Sheet2!B$1:B$500,$G2)

然後將其拖過,然後將所有這些拖下來。

答案3

根據這兩個文件的大小,您也可以嘗試使用 Excel 文件查詢:

  • 定義第一個 Excel 表的名稱(公式標籤 -> 定義名稱)
  • 定義第二個 Excel 表格的名稱
  • 轉到“資料”選項卡,選擇“來自其他來源”,然後從下拉清單中選擇“來自 Microsoft Query”
  • 選擇您的工作簿文件並確認您要手動合併列
  • 在下面的“從 Excel 文件查詢”視窗中,將第一個表的第一列拖放到第二個表的第一列中 - 將創建這些列之間的鏈接
  • 前往“檔案”選單,點擊“將資料返回 MS Office Excel”,將彈出“匯入資料”對話框
  • 選擇您想要將符合資料匯入的工作表
  • 按一下「確定」-> 您應該會看到與兩個表中的欄位相符的數據

相關內容