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

我一直在使用excel工具将近一周，现在我已经差不多完成了，结果发现自己正面临着一个我目前无法解决的问题解决。VBA跨工作表颜色编码匹配的单元格内有匹配值

在我的工作簿一个表我有这样的事情：

现在我要的颜色代码使用Sheet2中与之相匹配的这个（填写细胞颜色）。所以，你得到一个想法，这里的Sheet2中：

所以在Sheet1中行将获得色彩通过检查在Sheet2上相应的A柱编码。例如：如果单元格A2表示ABC，我希望宏填充第2行中具有黄色值的所有单元格（如您在F1中看到的：表单2中的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

我会非常感激这个帮助！提前致谢。

来源

2017-03-17 D. Todor

这是不是可以很方便地与条件格式规则？颜色传说当然不会经常改变。 – Jeeped

@Jeeped你是指与标准的Excel公式匹配？我不明白这怎么可能...... –

我不禁告诉我尽可能避免条件格式化，因为它倾向于使工作簿变大，最终通过用户复制和粘贴最终传播到整个地方，最终失去控制。我发布了一个VBA解决方案 – user3598756

你可以试试这个：

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

来源

2017-03-17 19:49:29 user3598756

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

回答

相关问题