Question

我需要一个与表1中表2中的患者姓名相匹配的公式，然后查看该行中的H列是否有＆＃39;是＆＃39;写在其中，如果是这样，将表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

这样的事可能对你有用，不确定我是100％你想做什么。

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

VBA宏查找一个列值到不同表中的其他列

2 个答案: