excel - 匹配行标题

Question

我有一个映射表，用于匹配两个单独工作表（Sheet1 和 Sheet2）的列标题。但是，当我还想匹配行标题（月份）时，代码匹配的是行，而不是 A 列上的单元格。有什么想法可以让这个工作吗？先感谢您！:)

Sheet1-src：

Sheet2- trgt（在我运行代码后，它也应该匹配 Oct、Nov、Dec）：

,

映射表：

Sheet2-我需要什么：

Public Sub ceva()
  Application.ScreenUpdating = False
  stack "Sheet1", "Sheet2", "Mapping"
  Application.ScreenUpdating = True
End Sub    

Public Sub stack (ByVal Sheet1 As String, ByVal Sheet2 As String, ByVal Mapping As String)
Dim rng As Range, src As Worksheet, trgt As Worksheet, helper As Worksheet
Dim sht As Worksheet
Dim dctCol As Dictionary, dctHeader As Dictionary
Dim strKey1 As String, strKey2 As String
Dim strItem As String, col As Integer
Dim LastRow As Long, LastCol As Long

Set src = Worksheets(Sheet1)
Set trgt = Worksheets(Sheet2)
Set helper = Worksheets(Mapping)          

LastRow = trgt.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastCol = trgt.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

Set dctCol = New Dictionary
arr1 = src.Range("A1:F9")
''arr1 = src.Range("A4").End(xlDown).End(xlToRight)
For j = 2 To UBound(arr1, 2)
    strKey1 = Trim(arr1(1, j)) & "," & Trim(arr1(2, j)) & "," & Trim(arr1(3, j)) 
    dctCol(strKey1) = j 
Next

'build a dictionary to translate 2 headers to 3 headers
Set dctHeader = New Dictionary
arrHelp = helper.Range("A2:E6")
For i = 1 To UBound(arrHelp)
    strKey2 = Trim(arrHelp(i, 4)) & "," & Trim(arrHelp(i, 5)) '2 header key
    strItem = Trim(arrHelp(i, 1)) & "," & Trim(arrHelp(i, 2)) & "," & Trim(arrHelp(i, 3))
    dctHeader(strKey2) = strItem
Next

'update sheet2 with numbers from sheet1    
arr2 = trgt.Range("A1:F12")
For j = 2 To 6
    'work backwards to find the column
    strKey2 = Trim(arr2(1, 2)) & "," & Trim(arr2(2, j)) '2 headers
    strKey1 = dctHeader(strKey2)
    col = dctCol(strKey1)
    
    For i = 3 To 12
      If src.Cells(i + 1, "A").Value = trgt.Cells(i, "A").Value Then
        arr2(i, j) = arr1(i + 1, col)
      Else
    
      End If
    Next       
Next

trgt.Range("A1").Resize(UBound(arr2), UBound(arr2, 2)) = arr2
End Sub

Answer 1

为月份建立另一个字典以进行行查找

'update sheet2 with numbers from sheet1
arr2 = trgt.Range("A1:F12")

' month to row
Dim dctRow As Dictionary, key As String
Set dctRow = New Dictionary
For j = 4 To UBound(arr1)
    dctRow(Trim(arr1(j, 1))) = j
Next

For j = 2 To 6
    'work backwards to find the column
    strKey2 = Trim(arr2(1, 2)) & "," & Trim(arr2(2, j)) '2 headers
    strKey1 = dctHeader(strKey2)
    col = dctCol(strKey1)
    
    For i = 3 To 12
        key = arr2(i, 1)
        If dctRow.Exists(key) Then
            arr2(i, j) = arr1(dctRow(key), col)
        End If
    Next
Next