構造が異なる 2 つの Excel ファイルからデータを結合するにはどうすればよいですか?

Question

財務データを含む非常に大きな Excel ファイルが 2 つあります。1 つのファイルのデータを他のファイルのデータと結合する必要があります。最初のファイルのすべての行にはカテゴリ コードが割り当てられています。2 番目のファイルの一部の行には同じコードが割り当てられている可能性があります。最初
のファイルのすべての行と、2 番目のファイルの同じコードを持つすべての一致する行を結合する必要があります。ファイルには列数が異なります。

これにどう対処したらいいでしょうか?

Answer 1

まず、データを整列させるために必要な列をファイルに追加し、最小のファイルから最大のファイルまでデータを切り取って貼り付け、カテゴリ コードで並べ替えます。

VBA でこれを行う 1 つの方法を以下に示します。このコードは、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

ユーティリティコードが見つかりましたここそしてここ。

Answer 2

この種のタスクは Microsoft Access の目的であり、「左結合」と呼ばれます。ただし、Excel でも、vlookup または match と index 関数を使用してこれを行うことができます。個人的には、match/index の方が好みです。

Sheet1 A:F が最初のファイルで、2 番目のファイルを Sheet2 A1:Q500 に配置するとします。コードは両方の列 A にあるとします。次に、Sheet1 の G2 に次のように入力します。

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

次に、H2 に次のように入力します。

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

次にこれを横にドラッグし、これらすべてを下にドラッグします。

Answer 3

2 つのファイルのサイズに応じて、Excel ファイルからのクエリを使用することもできます。

• 最初の Excel テーブルの名前を定義します (数式タブ -> 名前の定義)
• 2番目のExcelテーブルの名前を定義する
• データタブに移動し、「その他のソースから」を選択し、ドロップダウンから「Microsoft Queryから」を選択します。
• ワークブックファイルを選択し、列を手動で結合することを確認します
• 次のウィンドウ「Excelファイルからのクエリ」で、最初のテーブルの最初の列を2番目のテーブルの最初の列にドラッグアンドドロップします。これらの列の間にリンクが作成されます。
• ファイルメニューに移動し、「データをMS Office Excelに戻す」をクリックすると、データのインポートダイアログがポップアップ表示されます。
• 一致したデータをインポートするシートを選択します
• [OK]をクリックすると、両方のテーブルの列に一致するデータが表示されます。