高級索引匹配

Question

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

在 Sheet1 中，我有以下數據集：

在 Sheet2 中，我有以下數據集：

我需要創建一個代碼來執行以下操作：

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

例如，對於“SpeGro 分數”列，它需要：

• 在 Sheet1 中搜索與 SpeGro 對應的 header 列（在本例中為第 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