VBA 按列查找小工具类似lookUp函数

如上图，查找A列的数据在D,F列是否存在，如果存在背景色变绿，如果不存在则A列的背景色变红。

直接贴上代码：

1 Private Sub CommandButton1_Click()
2     Call lookUpAToDF
3 End Sub

View Code

 1 Public Sub lookUpAToDF()
 2    Dim a, d, f As Long
 3    'Count of non-empty data in colum A,D,F
 4    a = Application.WorksheetFunction.CountA(Range("A:A"))
 5    d = Application.WorksheetFunction.CountA(Range("D:D"))
 6    f = Application.WorksheetFunction.CountA(Range("F:F"))
 7    Dim ac, dc, fc As Integer
 8    'loop the A
 9    For ac = 1 To a Step 1
10        Dim aTxt As String
11        ' get column A value
12        aTxt = TrimSpace(Cells(ac, 1).Text)
13        If aTxt = "" Then
14            Exit For
15        End If
16        ' add flg var for switch selected aTxt
17        Dim flg As Boolean
18        flg = True
19        For dc = 1 To d Step 1
20            Dim dTxt As String
21            dTxt = TrimSpace(Cells(dc, 4).Text)
22            If aTxt = dTxt Then
23                flg = False
24                Exit For
25            End If
26        Next dc
27        'if column D selected result is empty then
28        'loop the colum F
29        If flg Then
30            For fc = 1 To f Step 1
31                Dim fTxt As String
32                fTxt = TrimSpace(Cells(fc, 6).Text)
33                If aTxt = fTxt Then
34                    flg = False
35                    Exit For
36                End If
37            Next fc
38        End If
39        If flg Then
40            Cells(ac, 1).Interior.ColorIndex = 3 'red
41        Else
42            Cells(ac, 1).Interior.ColorIndex = 4 'green
43        End If
44    Next ac
45    MsgBox "find completed!"
46 End Sub
47 Public Function TrimSpace(strItem As String) As String
48    Dim resultStr As String
49    resultStr = LTrim(strItem)
50    resultStr = RTrim(resultStr)
51    TrimSpace = resultStr
52 End Function

代码还没有优化，行数达到10000+的时候会有卡顿。