• 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+的时候会有卡顿。

  • 相关阅读:
    html悬停文字
    在线表单验证
    无法定位ul列表的下拉选项
    HDU 4576 Robot(概率dp+滚动数组)
    HDU 4405 Aeroplane chess(期望dp)
    CodeForces 401C Team(简单构造)
    POJ 2253 Frogger(最短路Dijkstra or flod)
    HDU 4763 Theme Section(kmp)
    【JZOJ5462】好文章【哈希】
    【JZOJ5462】好文章【哈希】
  • 原文地址:https://www.cnblogs.com/forbetter223/p/10435153.html
Copyright © 2020-2023  润新知