匹配来自两个来源的数据和 excel 中的简单计算

Question

我需要对 data-set 进行一些计算。计算很简单（即输入 1 x 输入 2 = 输出），但它们采用不同人记录在两个不同 excel 工作簿中的输入。由于不同的输入源，两者之间的参数有时顺序不同或名称略有不同 - 附图应该显示我的意思。

我的计划是将输入书 1 的相关 sheet 和输入书 2 的相关 sheet 复制到一个工作簿中，我希望将参数与某种 lookup/find 宏，并使用循环自动执行计算以跨 headers 行向下工作

组合作品sheet概念

非常感谢任何帮助。

Answer 1

即使你看起来不像我对解决这个问题感兴趣，我准备了下一个代码，假设从字符串 "apple,banana,orange,grape" 获得的数组涵盖了 sheet 的奇怪样式头列命名。

我用 "X1" 作为你的第一个 sheet 名字，"X2" 作为第二个名字，"Result" 作为前两个名字的匹配值：

Sub MatchingLike_bis()
  Dim arrNames As Variant, sh1 As Worksheet, sh2 As Worksheet, sRez As Worksheet
  Dim lastR1 As Long, lastR2 As Long, arrRez As Variant, arr1 As Variant, arr2 As Variant
  Dim i1 As Long, i2 As Long, El As Variant, k As Long, col1 As Long, col2 As Long
  Dim strProbl1 As String, strProbl2 As String, colTot As Long, boolF As Boolean, i As Long

  arrNames = Split("apple,banana,orange,grape,lemon", ",")
  colTot = UBound(arrNames) + 2 'The array is zero based and A is excepted

  Set sh1 = ThisWorkbook.Sheets("X1")
  Set sh2 = ThisWorkbook.Sheets("X2")
  Set sRez = ThisWorkbook.Sheets("Result")
   lastR1 = sh1.Range("A" & sh1.Rows.count).End(xlUp).Row
   lastR2 = sh2.Range("A" & sh2.Rows.count).End(xlUp).Row

   arr1 = sh1.Range(sh1.Cells(1, 1), sh1.Cells(lastR1, colTot)).Value
   arr2 = sh2.Range(sh2.Cells(1, 1), sh2.Cells(lastR1, colTot)).Value

   'preliminary check if all fruits name has a corespondent in both necessary sheets:__________
   strProbl1 = "": strProbl2 = ""
   For Each El In arrNames
        For i1 = 2 To colTot 'make checking in first sheet
            If InStr(UCase(arr1(1, i1)), UCase(El)) > 0 Then
                boolF = True: Exit For
            End If
        Next i1
        If Not boolF Then strProbl1 = strProbl1 & El & vbCrLf
        boolF = False
        For i2 = 2 To colTot 'make checking in the second sheet
            If InStr(UCase(arr2(1, i2)), UCase(El)) > 0 Then
                boolF = True: Exit For
            End If
        Next i2
        If Not boolF Then strProbl2 = strProbl2 & El & vbCrLf
        boolF = False
   Next
   If strProbl1 <> "" Then MsgBox "In " & sh1.Name & " sheet, the next fruit names are" & _
                " incorrect, or missing:" & vbCrLf & _
                vbCrLf & strProbl1 & vbCrLf & "Please correct the spelling and run the application again!", _
                vbInformation, "Wrong spelling in " & sh1.Name & " worksheet": sh1.Activate: Exit Sub
   If strProbl2 <> "" Then MsgBox "In " & sh2.Name & " sheet, the next fruit names are" & _
                " incorrect, or missing:" & vbCrLf & _
                vbCrLf & strProbl2 & vbCrLf & "Please correct the spelling and run the application again!", _
                vbInformation, "Wrong spelling in " & sh2.Name & " worksheet": sh2.Activate: Exit Sub
   '_________________________________________________________________________________________________

   ReDim arrRez(1 To UBound(arr1, 1), 1 To colTot) 'result array will have exactly the
                                                   'number of rows and columns as arr1
   For i1 = 1 To UBound(arr1, 1)
     If i1 = 1 Then
        arrRez(i1, 1) = Empty
        For i = 2 To colTot
           arrRez(i1, i) = arr1(i1, i)
        Next i
     Else
        For i2 = 1 To UBound(arr2, 1)
            If arr1(i1, 1) = arr2(i2, 1) Then
                arrRez(i1, 1) = arr1(i1, 1)
                'find the right reference in the accepted keys array:
                For Each El In arrNames
                    For k = 2 To colTot
                        If InStr(UCase(arr1(1, k)), UCase(El)) > 0 Then col1 = k
                        If InStr(UCase(arr2(1, k)), UCase(El)) > 0 Then col2 = k
                    Next k
                    If col1 > 0 And col2 > 0 Then
                        arrRez(i1, col1) = arr1(i1, col1) + arr2(i2, col2)
                        col1 = 0: col2 = 0
                    End If
                Next
            End If
        Next i2
     End If
   Next i1
   With sRez.Range(sRez.Range("A1"), sRez.Cells(lastR1, colTot))
    .Value = arrRez
    .EntireColumn.AutoFit
  End With
End Sub

这个版本允许在字符串 "apple,banana,orange,grape,lemon" 中添加一个新的水果名称（我已经添加了柠檬）并且代码会根据需要自动适应 return 尽可能多的列。它进行初步检查并发送有关在两个输入 sheet 中拼写错误的水果名称的相关消息。仅当所有水果名称在两个输入 sheets...

中都匹配时，代码才会完全运行

匹配来自两个来源的数据和 excel 中的简单计算

Matching data from two sources and simple calculations in excel

excel

vba

string-matching

calculated-field