具有值的单元格内的 VBA 跨工作表颜色编码匹配答案

【问题标题】：VBA cross-worksheet color coded matching within cells that have a value具有值的单元格内的 VBA 跨工作表颜色编码匹配
【发布时间】：2017-03-17 15:48:14
【问题描述】：

我已经使用 excel 工具将近一周了，当我几乎完成时，我发现自己面临一个我目前无法解决的问题。

在我的工作簿的一张纸上，我有这样的内容：

现在我想使用 sheet2 对其进行颜色编码（用颜色填充单元格）以匹配它。所以你有一个想法，这里是 sheet2：

因此 sheet1 中的行将通过检查 sheet2 上的相应 A 列来进行颜色编码。例如：如果单元格 A2 显示 ABC，我希望宏填充第 2 行中的每个单元格，其中每个单元格的值都是黄色的（如您在 sheet2 中的 F1:G3 中看到的，ABC 表示黄色）。

所以最后它应该是这样的：

我已经尝试编写一些代码来完成它，不幸的是它没有工作。不过，你可以看看它，也许它对你有帮助。

Sub colormatching()

Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim aCol As Long
Dim MaxRowList As Long, destiny_row As Long, x As Long

Set wsSource = ThisWorkbook.Worksheets("Sheet1")
Set wsTarget = ThisWorkbook.Worksheets("Sheet2")

aCol = 1
MaxRowList = wsSource.Cells(Rows.Count, aCol).End(xlUp).Row


destiny_row = 1
For x = 2 To MaxRowList
    If InStr(1, wsTarget.Cells(x, 1), "ABC") > 0 Then
        wsSource.Range("$A$" & x).Select
        With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 65535
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
destiny_row = destiny_row + 1
    End If
Next
End Sub

如果能在这方面提供帮助，我将不胜感激！提前致谢。

【问题讨论】：

使用条件格式规则不是更容易吗？当然，颜色图例不会经常更改。
@Jeeped 你指的是匹配标准的excel公式吗？我不明白这怎么可能......
我不能不告诉我尽可能避免使用条件格式，因为它会使工作簿变大并最终通过用户复制和粘贴传播到整个地方，最终失去控制。我发布了一个 VBA 解决方案

标签： vba excel

【解决方案1】：

你可以试试这个：

Sub main()
    Dim cell As Range

    With ThisWorkbook.Worksheets("Sheet1")
        .UsedRange.Interior.ColorIndex = xlNone '<--| clear preceeding cells coloring
        For Each cell In Intersect(.Columns(1), .UsedRange.SpecialCells(xlCellTypeConstants).EntireRow)
            cell.EntireRow.SpecialCells(xlCellTypeConstants).Interior.ColorIndex = GetColorIndex(cell.row)
        Next
    End With
End Sub

Function GetColorIndex(rowIndex As Long) As Variant    
    With ThisWorkbook.Worksheets("Sheet2")
        GetColorIndex = .Range("F1:F3").Find(what:=.Cells(rowIndex, 1), LookIn:=xlValues, lookat:=xlWhole).Offset(, 1).Interior.ColorIndex
    End With
End Function

【讨论】：