高级索引匹配

Question

在我的工作簿中，我有 2 个工作表：Sheet1 和 Sheet2。

在 Sheet1 中，我有以下数据集：

在 Sheet2 中，我有以下数据集：

我需要创建一个执行以下操作的代码：

• 填充分数列（“SpeGro 分数”、“PrimSpe 分数”等）

例如，对于“SpeGro 分数”列，它需要：

• 在 Sheet1 中搜索与 SpeGro 对应的列标题（在本例中为第 4 列）；
• 第 4 列的值需要与 Sheet2 第 3 列的值匹配。
• 仅考虑 Sheet2 中具有 DIMENSION "SpeGro" 的值（在本例中）；
• 仅考虑 PrdInd (Sheet1) = PrdInd (Sheet2) 的值。

额外信息：如果我只有 DIMENSION，我有一个 INDEX-MATCH 公式：

For k = 2 To RowNum
    tWb.Sheets("Sheet1").Cells(k, 6).Value = Application.IfError(Application.Index(tWb.Sheets("Sheet2").Range("D:D"), Application.Match(tWb.Sheets("Sheet1").Cells(k, 4), tWb.Sheets("Sheet2").Range("C:C"), 0)), 0)
Next k

知道如何实现这一目标吗？

Answer 1

这只是为了让您了解如何处理此任务。但是，如果您想尝试，代码是有效的。

'task: Populate the score columns ("Score of SpeGro", "Score of PrimSpe", etc.)
'if conditions are met

Sub Whatever()

Dim strSearch As String
Dim aCell As Range
Dim col_n As Integer
Dim last_row As Long
Dim first_row As Byte
Dim Count As Long

'Search in Sheet1 the column header corresponding to
'"Score of SpeGro" (in this case it's column 6)

'CONFIG
'-------------
strSearch = "Score of SpeGro"
first_row = 2 'first row of the data sets in sheet 1 and 2
'-------------    

Set aCell = Sheet1.Rows(1).Find(What:=strSearch, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
    
col_n = aCell.Column

'column numbers sheet1

'Scoreof PrimSpe column numner = col_n +1
'SpeGro column number = col_n - 2
'Prdlnd column number = col_n - 5

last_row = Sheets("Sheet1").Cells(Rows.Count, col_n - 5).End(xlUp).Row

For Count = first_row To last_row

If Sheets("Sheet1").Cells(Count, col_n - 2) = Sheets("Sheet2").Cells(Count, 3) _
And Sheets("Sheet2").Cells(Count, 2) = "SpeGro" _
And Sheets("Sheet1").Cells(Count, col_n - 5) = Sheets("Sheet2").Cells(Count, 1) Then

Sheets("Sheet1").Cells(Count, col_n) = "Put something here"

End If

Next Count

End Sub

Answer 2

Option Explicit

Sub Button1_Click()

'task: Populate the score columns ("Score of SpeGro", "Score of PrimSpe", etc.)
'if conditions are met

Dim strSearch1 As String, strSearch2 As String
Dim aCell1 As Range, aCell2 As Range
Dim col_n1 As Integer, col_n2 As Integer
Dim last_row1 As Long, last_row2 As Long
Dim first_row As Byte
Dim Count As Long
Dim myArray As Variant, element As Variant

'Search in Sheet1 the column header corresponding to
'"Score of SpeGro" (in this case it's column 6)

myArray = Array("Specialty Grouping", "Primary Specialty")

'strSearch1 = "Score of Specialty Grouping"
'strSearch2 = "Specialty Grouping"

For Each element In myArray
    Set aCell1 = Sheet1.Rows(1).Find(What:="Score of " & element)
    Set aCell2 = Sheet1.Rows(1).Find(What:=element)
        
    col_n1 = aCell1.Column
    col_n2 = aCell2.Column
    
    'column numbers sheet1
    
    'SpeGro column number = col_n2
    
    last_row1 = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    last_row2 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
    
    'The values of col_n2 need to match the values in column 3 of USER_INPUTS.
    
    For Count = 2 To last_row1
        Sheets("Sheet1").Cells(Count, col_n1) = Application.Index(ThisWorkbook.Sheets("Sheet2").Range("D2:D" & last_row2), _
        Application.Match(ThisWorkbook.Sheets("Sheet1").Cells(Count, 1), ThisWorkbook.Sheets("Sheet2").Range("A2:A" & last_row2), 0) * _
        Application.Match(ThisWorkbook.Sheets("Sheet1").Cells(1, col_n2), ThisWorkbook.Sheets("Sheet2").Range("B2:B" & last_row2), 0) * _
        WorksheetFunction.IfError(Application.Match(ThisWorkbook.Sheets("Sheet1").Cells(Count, col_n2), ThisWorkbook.Sheets("Sheet2").Range("C2:C" & last_row2), 0), 0))
    Next Count
Next element
    
End Sub