Question

我是Excel宏VBA的新手，所以请耐心等待。

我的Excel文件设置如下：

Col1    Col2
----    ----
a       a
b       c
c       e
d       g
e       i
f
g
h
i
j

我想编写一个VBA宏函数，它会在Col2中找到Col1中的值，如果找到它，那么它会将该单元格的字体颜色设置为红色， Col1 ..

因此，对于上面的示例数据，a中的值c，e，g，i，Col1应转向{ {1}}颜色。

对于上面的示例，假设red值来自Col1，而A3:A13来自Col2 ..

我正在使用Excel 2010 ..

如何在Excel VBA宏中完成此操作？

Answer 1

我把它变成粉红色。细胞A1：A10 ..细胞B1：B5 ..

Sub Test()
Dim x1, x2 As Integer

For x2 = 1 To 5
  For x1 = 1 To 10
    If Range("A" & Format(x1)).Value = Range("B" & Format(x2)).Value Then          
       Range("A" & Format(x1)).Font.Color = vbRed
    End If
  Next
Next
End Sub

Answer 2

我想用这个来测试我的技能，尽管@matzone已经给出了确切的答案。我创建了这个Sub，它完全相同，但使用了Range个对象和.Find()方法。评论......

Private Sub Test()
    FindAndColorMatchesOfTwoColumns "A", "B"
End Sub

Private Sub FindAndColorMatchesOfTwoColumns(colTarget As String, colList As String)
    Dim rLookUp As Range        ' Column range for list compared against
    Dim rSearchList As Range    ' Column range for compare items
    Dim rMatch As Range
    Dim sAddress As String

    ' Set compared against list from colTarget column
    Set rLookUp = Range(colTarget & "1:" & _
                  colTarget & Range(colTarget & "1").End(xlDown).Row)

    ' Loop trough list from colList column
    For Each rSearchList In Range(colList & "1:" & colList & Range(colList & "1").End(xlDown).Row)

        ' Find for a match
        Set rMatch = rLookUp.Find(rSearchList.Value, LookAt:=xlWhole)
        If Not rMatch Is Nothing Then
            ' Store first address found
            sAddress = rMatch.Address

            ' Loop trough all matches using .FindNext,
            '   exit if found nothing or address is first found
            Do
                ' Set the color
                rMatch.Font.Color = vbRed

                Set rMatch = rLookUp.FindNext(rMatch)

            Loop While Not rMatch Is Nothing And rMatch.Address <> sAddress
        End If
    Next

    Set rMatch = Nothing
    Set rSearchList = Nothing
    Set rLookUp = Nothing
End Sub

这个想法是更动态，接受两列作为参数，将搜索范围设置为Range.End(xlDown).Row而不是固定计数。也是循环槽只匹配。

对于原始问题，简单的.Cells()嵌套循环更简单，但如果列数达到千（s），则使用.Find()将证明更快。

使用此测试子测试“长列表”假设：

Private Sub RunTest()
    Dim tStart As Date
    Dim tEnd As Date

    tStart = Timer
    FindAndColorMatchesOfTwoColumns "A", "B"
    tEnd = Timer

    Debug.Print Format(tEnd - tStart, "0.000")


    tStart = Timer
    Test
    tEnd = Timer

    Debug.Print Format(tEnd - tStart, "0.000")
End Sub

向A列添加了1500行，向B列添加了184行，并将立即视图结果添加为：

0,266
12,719

因此，性能确实存在巨大差异......如果OP仅提供简单的问题示例，并打算在更大的数据集中使用它。

Answer 3

简单的几行宏可以解决问题，如下所示：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Integer, j As Integer
For j = 1 To Cells(1, 2).End(xlDown).Row
    For i = 1 To Cells(1, 1).End(xlDown).Row
       If Cells(j, 2) = Cells(i, 1) Then
         Cells(i, 1).Font.ColorIndex = 3
       End If
    Next
Next
End Sub

Answer 4

这是另一种选择。它可能并不漂亮，但只是展示了实现相同解决方案的不同方式。

Sub updateFontColour()

Dim rngCol1 As Range
Dim rngCol2 As Range
Dim myvalue As Long
Dim c As Range

'Set the ranges of columns 1 and 2. These are dynamic but could be hard coded
Set rngCol1 = ThisWorkbook.Sheets("Sheet1").Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row)
Set rngCol2 = ThisWorkbook.Sheets("Sheet1").Range("B3:B" & Range("B" & Rows.Count).End(xlUp).Row)

'Loop through range 1 (column A) and use the 'Match' function to find a match in range 2 (column B)
For Each c In rngCol1
    On Error Resume Next
    'I use the error handler as the match function returns a relative position and not an absolute one.
    If IsError(myvalue = WorksheetFunction.Match(c.Value, rngCol2, 0)) Then
        'Do noting, just move next
    Else
        c.Font.Color = vbRed
    End If

Next

End Sub

如何在另一列中找到一列的值并改变颜色？

4 个答案: