0

我是 Excel 宏 VBA 的新手，所以请多多包涵。

我有一个这样的 Excel 文件：

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

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

因此，对于上面的示例数据，值a, c, e, g, iinCol1应该变成red颜色。

对于上面的示例，假设Col1值来自A3:A13，并且Col2来自B3:B13..

我正在使用 Excel 2010 ..

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

4

4 回答 4

2

我把它变成粉红色 .. 单元格 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
于 2013-07-17T06:47:43.853 回答
0

我想用这个来测试一下我的技能，尽管@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()嵌套循环要简单得多，但是.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

将 1500 行添加到 A 列，将 184 行添加到 B 列并获得即时视图结果：

0,266
12,719

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

于 2013-07-17T10:06:52.193 回答
0

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

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
于 2013-07-17T11:53:00.443 回答
0

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

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
于 2013-07-17T13:41:33.277 回答