VBA宏可在另一張工作表中查找另一列的值

Question

我需要一個與工作表1中工作表2中的患者姓名相匹配的公式，然后查看該行中的H列是否寫有“是”，如果是，請將工作表2中該行的顏色更改為紅色。

我寫了這個公式-

Dim patient1 As String
Dim patient2 As String
Dim answer As String
Dim c As Range
Dim counter As Long
Dim total As Long
counter = 1
total = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To total
answer = Worksheets("hedis1").Range("h" & counter).Value
patient1 = Worksheets("hedis1").Range("d" & counter).Value
patient2 = Worksheets("hedis2").Range("d" & counter).Value
k = "a" & counter
If patient1 = patient2 Then
   If answer = "Yes" Then
        For Each c In Worksheets("hedis2").Range(k)

            c.EntireRow.Interior.Color = 255 ' Change the number to match the desired color.

        Next c
   End If
End If
counter = counter + 1
Next i

我想檢查電子表格1的D列到電子表格2的D列的所有值。 我的公式僅檢查相同的行。 希望你理解我在說什么。 謝謝

Answer 1

這樣的事情可能對您有用，但不確定我對您想要的內容是否滿意。

Sub thisone()
Dim patient1 As String
Dim patient2 As String
Dim answer As String
Dim c As Range
Dim counter As Long
Dim total As Long
Dim totalInner As Long
counter = 1
total = Range("A" & Rows.Count).End(xlUp).Row
totalInner = Worksheets("hedis2").Range("d" & Rows.Count).End(xlUp).Row
For i = 1 To total
answer = Worksheets("hedis1").Range("h" & counter).Value
patient1 = Worksheets("hedis1").Range("d" & counter).Value
k = "a" & counter
For j = 1 To totalInner
    patient2 = Worksheets("hedis2").Range("d" & j).Value

    If patient1 = patient2 Then
        If answer = "Yes" Then
            For Each c In Worksheets("hedis2").Range(k)

                c.EntireRow.Interior.Color = 255 ' Change the number to match the desired color.

            Next c
        End If
    End If
    Next j
counter = counter + 1
Next i
End Sub

Answer 2

使用工作表匹配功能，其速度非常快...

Dim patient1 As String
Dim answer As String
Dim total As Long
Dim iRowMatched As Long

total = Range("A" & Rows.Count).End(xlUp).Row

On Error Resume Next
For i = 1 To total
    answer = Worksheets("hedis1").Range("h" & counter).Value
    patient1 = Worksheets("hedis1").Range("d" & counter).Value

    iRowMatched = WorkSheetFunction.Match(patient1,Worksheets("hedis1").Range("$D:$D"),0)
    If Err.Number = 0 Then
           If answer = "Yes" Then
                Worksheets("hedis2").Rows(iRowMatched).Interior.Color = vbRed '
           End If
    Else
       Err.Clear
    End If
Next i
On Error Goto 0