☰

如何合并两个不同结构的 Excel 文件的数据？

tag-icon • tag-icon microsoft-excel vba
如何合并两个不同结构的 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 所要完成的，称为“左连接”。但您仍然可以在 Excel 中使用 vlookup 或使用 match 和 index 函数来执行此操作。我个人更喜欢 match/index。

假设 Sheet1 A:F 是第一个文件，而您将第二个文件放在 Sheet2 A1:Q500 上。假设您的代码在两个文件的 A 列中。然后在 Sheet1 的 G2 中输入以下内容：

=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”，将弹出“导入数据”对话框
  • 选择要导入匹配数据的工作表
  • 单击“确定”-> 您应该看到来自两个表的列匹配的数据

相关内容