VBA按列查⼩⼯具类似lookUp函数
如上图，查A列的数据在D,F列是否存在，如果存在背景⾊变绿，如果不存在则A列的背景⾊变红。
直接贴上代码：
1Private Sub CommandButton1_Click()
2Call lookUpAToDF
3End Sub
View Code
1Public Sub lookUpAToDF()
2Dim 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"))
7Dim ac, dc, fc As Integer
8'loop the A
9For ac = 1To a Step1
10Dim aTxt As String
11' get column A value
12        aTxt = TrimSpace(Cells(ac, 1).Text)
13If aTxt = ""Then
14Exit For
15End If
16' add flg var for switch selected aTxt
17Dim flg As Boolean
18        flg = True
19For dc = 1To d Step1
20Dim dTxt As String
21            dTxt = TrimSpace(Cells(dc, 4).Text)
22If aTxt = dTxt Then
23                flg = False
24Exit For
25End If
26Next dc
27'if column D selected result is empty then
28'loop the colum F
29If flg Then
30For fc = 1To f Step1
31Dim fTxt As String
32                fTxt = TrimSpace(Cells(fc, 6).Text)
33If aTxt = fTxt Then
34                    flg = False
35Exit For
36End If
37Next fc
38End If
39If flg Then
40            Cells(ac, 1).Interior.ColorIndex = 3'red
41Else
42            Cells(ac, 1).Interior.ColorIndex = 4'green
43End If
44Next ac
45MsgBox"find completed!"
46End Sub
47Public Function TrimSpace(strItem As String) As String
48Dim resultStr As String
49    resultStr = LTrim(strItem)
50    resultStr = RTrim(resultStr)
51    TrimSpace = resultStr
52End Function
lookup函数查不正确代码还没有优化，⾏数达到10000+的时候会有卡顿。

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。