将一张纸上的一列中的单元格的值与另一张纸上的列中的所有值进行比较。 根据结果​​对行进行着色

我有Sheet1 ColumnA上的名称列表，并且需要查看它们是否出现在Sheet2 ColumnB中。

如果在Sheet2 ColumnB上存在Sheet1 ColumnA上的名称，则需要为Sheet1.ColumnA Green上的Row着色。 如果不是，则为红色行着色。

---

最终为我的具体问题工作的代码是这样的：

Sub ColorCells() Application.ScreenUpdating = False Dim c, Finder With Sheets("Sheet1") For Each c In .Range("A1:A" & .Cells(Rows.CountLarge, "A").End(xlUp).Row) Set Finder = Sheets("Sheet2").Range("B:B").Find(c.Value, LookAt:=xlWhole) If Not Finder Is Nothing Then c.EntireRow.Interior.Color = RGB(180, 230, 180) Else c.EntireRow.Interior.Color = RGB(230, 180, 180) End If Next c End With Application.ScreenUpdating = True End Sub 

Answer 1

我想出了这个，希望这是你正在寻找的东西。

 Dim rcnt As Long, ws1 As Worksheet, ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") rcnt = ws2.Range("B1", ws2.Range("B2").End(xlDown)).Rows.Count For x = 1 To rcnt If ws1.Cells(x, 1) = ws2.Cells(x, 2) Then ws1.Cells(x, 1).EntireRow.Interior.Color = RGB(0, 255, 0) Else: ws1.Cells(x, 1).EntireRow.Interior.Color = RGB(255, 0, 0) End If Next x 

Answer 2

基本解决scheme – 如果您拥有难以置信的大数据集，这可能需要一些时间。

您可以将LookAt:=xlWhole更改为LookAt:=xlPart如果您想查看名称是否存在于单元的一部分而不是完全匹配。

 Sub ColorCells() Application.ScreenUpdating = False Dim c, Finder With Sheets("Sheet1") For Each c In .Range("A1:A" & .Cells(Rows.CountLarge, "A").End(xlUp).Row) Set Finder = Sheets("Sheet2").Range("B:B").Find(c.Value, LookAt:=xlWhole) If Not Finder Is Nothing Then c.Interior.Color = RGB(180, 230, 180) Else c.Interior.Color = RGB(230, 180, 180) End If Next c End With Application.ScreenUpdating = True End Sub 

另一种方法，你可以做到这一点使用条件格式

公式是：

=COUNTIFS(Sheet2!$B$1:$B$500000,A1)=0

=COUNTIFS(Sheet2!$B$1:$B$500000,A1)>0

您可以将公式中的范围更改为您希望使用的范围

您可以将其添加到第一个单元格中，单击“格式刷”（Format Painter） – 按F5 – 并放入您希望应用的范围内。

最后，如果你的值是唯一的，你可以使用这个方法：

这应该是一个使用字典和变体数组的非常快的方法 – 所有的比较都是在内存中完成的。

 Sub ColorTheCells() Dim s1, s2, r1(), r2(), d1, x Set d1 = CreateObject("Scripting.Dictionary") Set s1 = Sheets("Sheet1") Set s2 = Sheets("Sheet2") r1 = s1.Range("A1:A" & s1.Cells(Rows.CountLarge, "A").End(xlUp).Row).Value r2 = s2.Range("B1:B" & s2.Cells(Rows.CountLarge, "B").End(xlUp).Row).Value For x = LBound(r1, 1) To UBound(r1, 1) d1.Add r1(x, 1), x Next x s1.Range("A1:A" & s1.Cells(Rows.CountLarge, "A").End(xlUp).Row).Interior.Color = RGB(230, 180, 180) For x = LBound(r2, 1) To UBound(r2, 1) If d1.Exists(r2(x, 1)) Then s1.Cells(d1(r2(x, 1)), s1.Cells(1, 1).Column).Interior.Color = RGB(180, 230, 180) Next x End Sub