VBA code to look if value of cells in sheet 2 column have match in sheet 1 and if so copy cell from sheet 2

问题

I am new to VBA and have a problem that i am trying to solve. I have a sheet that i call static data (Sheet1). it has customer name , customer ID and column identifying use cases. My flex data (Sheet2) had customer ID, use case and status. I am trying to come up with VBA code that would copy the status for each customer into the corresponding use case column / cell. Any data in Sheet2 that can't be matched with a customer in Sheet 1 should be copied to a separate sheet Any help would be greatly appreciated.

Below are how the sheets are assembled

Sheet 1 Static data

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         |        |        |        |        |

Sheet 2 Flex data

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

Output sheet or Sheet 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         |        |        |        |        |

回答1:

OK lets see if we can get this done with VBA. Here is a potential solution with VBA. This is quick and dirty but it gets the job done. This depends on a sheet1 and a 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

回答2:

You can use a multi-criteria Index/Match:

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

entered as an array formula, with CTRL+SHIFT+ENTER

Then, finally wrap around =IfError([index/match],"") to hide anything.

Make sure to anchor the references, as in my example:

So you'll just refer to data on a separate page, I just put it on the same to make it easier to show.

回答3:

you could try this:

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

来源：https://stackoverflow.com/questions/42983672/vba-code-to-look-if-value-of-cells-in-sheet-2-column-have-match-in-sheet-1-and-i