如何find另一列的价值，并改变颜色？

我是Excel Macro VBA的新手，请耐心等待。

我有这样的Excel文件设置：

Col1 Col2 ---- ---- aa bc ce dg ei f g h i j 

我想编写一个VBAmacros函数，它将查找Col2中Col1 ，如果find，则将Col1中该单元格的字体颜色设置为红色。

因此，对于上面的示例数据， Col1值a ， c ， e ， g ， i应该变为red 。

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

我正在使用Excel 2010 ..

我怎样才能在Excel VBAmacros中完成这个？

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

我想用这个testing我的技能，即使@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 

这个想法是更dynamic的，接受两列作为参数，设置search范围，直到Range.End(xlDown).Row而不是固定计数。 循环槽只匹配。

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

用这个testing子testing了“长列表”假设：

 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

简单的几行macros可以解决这个问题：

 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

这是另一种select。 这可能不是很好，但只是表明有多less种不同的方式来实现相同的解决scheme。

 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