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跨工作表顏色編碼匹配的單元格內有匹配值

回答

相關問題