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

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

以下是如何组装床单

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

Sheet 2 Flex数据

 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

好吧，让我们看看我们是否可以用VBA做到这一点。 这是一个使用VBA的潜在解决scheme。 这是快速和肮脏的，但它完成了工作。 这取决于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 2

您可以使用多条件索引/匹配：

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

以数组公式的formsinput，使用CTRL + SHIFT + ENTER

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

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

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

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