VBA 代码查看工作表 2 列中的单元格值是否与工作表 1 匹配，如果匹配，则从工作表 2 复制单元格

Question

我是 VBA 新手，有一个我正在尝试解决的问题。我有一张我称之为静态数据的工作表（Sheet1）。它具有客户名称、客户 ID 和标识用例的列。我的弹性数据（Sheet2）有客户 ID、用例和状态。我正在尝试提出 VBA 代码，它将每个客户的状态复制到相应的用例列/单元格中。 Sheet2 中无法与 Sheet 1 中的客户匹配的任何数据都应复制到单独的工作表中 任何帮助将不胜感激。

以下是床单的组装方式

表 1 静态数据

Customer Name | Customer ID | Case 1 | Case 2 | Case 3 | Case 4 | Case 5
------------------------------------------------------------------------
Customer A    | 111         |        |        |        |        |
Customer B    | 222         |        |        |        |        |
Customer C    | 333         |        |        |        |        |
Customer D    | 444         |        |        |        |        |
Customer E    | 555         |        |        |        |        |

表 2 弹性数据

Customer ID  | Use Case | Status
---------------------------------
111          |Case 1    | Forecast
222          |Case 1    | Upside
111          |Case 2    | Upside
333          |Case 3    | Pipeline
444          |Case 4    | Pipeline
222          |Case 4    | Forecast
666          |Case 5    | Pipeline

输出工作表或工作表 1

Customer Name | Customer ID | Case 1 | Case 2 | Case 3 | Case 4 | Case 5
------------------------------------------------------------------------
Customer A    | 111         |Forecast|Upside  |        |        |
Customer B    | 222         |Upside  |        |        |Forecast|
Customer C    | 333         |        |        |Pipeline|        |
Customer D    | 444         |        |        |        |Pipeline|
Customer E    | 555         |        |        |        |        |

Answer 1

您可以使用多标准索引/匹配：

=Index([Status Range],Match([customer ID]&[Case No.],[customer ID Range]&[Case No. Range],0)

作为数组公式输入，使用 CTRL+SHIFT+ENTER

然后，最后环绕=IfError([index/match],"") 隐藏任何东西。

确保锚定引用，如我的示例所示：

所以你只需要在一个单独的页面上引用数据，我只是把它放在同一个页面上以便更容易显示。

Answer 2

好的，让我们看看我们是否可以使用 VBA 完成这项工作。 这是使用 VBA 的潜在解决方案。这既快又脏，但它可以完成工作。这取决于 sheet1 和 Sheet2。

Sub MatchCustomersToCase()

Dim lookUpValue

'step 1 select sheet 1 the spreadsheet.
 Sheet1.Select

'step 2 loop customer id

For I = 1 To 12

Set workingcell = Worksheets("Sheet1").Cells(I, 2)
lookUpValue = workingcell.Value
cellAddress = workingcell.Address()

'select sheet 2
Sheet2.Select

'find the value in sheet 2
 Call Find_value_in_sheet2(lookUpValue, cellAddress)


Next
End Sub



Sub Find_value_in_sheet2(somevalue, fromAddress)
    Dim FindString As String
    Dim Rng As Range
    Dim caseType As String
    Dim CaseValue As String
    Dim listOfValues As Variant

    listOfValues = Array(somevalue)

    If Trim(somevalue) <> "" Then
        With Sheets("Sheet2").Range("A:A")

            For I = LBound(listOfValues) To UBound(listOfValues)

            Set Rng = .Find(What:=listOfValues(I), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
             FirstAddress = Rng.Address
           Do

                Application.Goto Rng, True

                caseType = Rng.Offset(0, 1).Value

                If Trim(caseType) = "Case 1" Then
                    CaseValue = Rng.Offset(0, 2).Value
                    Sheet1.Range(fromAddress).Offset(0, 1).Value = CaseValue

                ElseIf Trim(caseType) = "Case 2" Then
                CaseValue = Rng.Offset(0, 2).Value
                    Sheet1.Range(fromAddress).Offset(0, 2).Value = CaseValue

                 ElseIf Trim(caseType) = "Case 3" Then
                CaseValue = Rng.Offset(0, 2).Value
                    Sheet1.Range(fromAddress).Offset(0, 3).Value = CaseValue

                ElseIf Trim(caseType) = "Case 4" Then

                CaseValue = Rng.Offset(0, 2).Value
                    Sheet1.Range(fromAddress).Offset(0, 4).Value = CaseValue

                ElseIf Trim(caseType) = "Case 5" Then

                CaseValue = Rng.Offset(0, 2).Value
                    Sheet1.Range(fromAddress).Offset(0, 5).Value = CaseValue

                End If

             Set Rng = .FindNext(Rng)
             Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
              End If
            Next I
        End With
    End If
End Sub

Answer 3

你可以试试这个：

Sub main()
    Dim cell1 As Range, cell2 As Range, flexRng As Range, filteredRng As Range, headersRng As Range

    With Worksheets("Sheet 2")
        Set flexRng = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
    End With

    With Worksheets("Sheet 1")
        Set headersRng = .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft))
        For Each cell1 In .Range("B2", .Cells(.Rows.Count, 2).End(xlUp))
            If GetFilteredRange(flexRng, cell1.Value, filteredRng) Then
                For Each cell2 In filteredRng
                    .Cells(cell1.Row, headersRng.Find(what:=cell2.Offset(, 1).Value, LookIn:=xlValues, lookat:=xlWhole).Column).Value = cell2.Offset(, 2)
                Next
            End If
        Next
    End With
End Sub

Function GetFilteredRange(rangeToFilter As Range, filterValue As Variant, filteredRange As Range) As Boolean
    With rangeToFilter
        .AutoFilter Field:=1, Criteria1:=filterValue
        If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then
            GetFilteredRange = True
            Set filteredRange = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
        End If
        .Parent.AutoFilterMode = False
    End With
End Function