Question

您好我最近问过这个问题： Assigning Colours to each Instance of a value，然而这最终没有为我工作，我不确定我是否应该继续该线程或开始一个新的因为我已经改变了一些东西。这是我的新代码，它在两列之间交替选择单元格并更改所选单元格的颜色，但是如果数字已经存在，我希望它们具有相同的颜色。我现在拥有的东西，尽管有匹配，似乎并不匹配并指定一个随机颜色。

Sub colourNumbers()
Dim a As Long
Dim b As Long
Set wf = Application.WorksheetFunction
Dim analysisSheet As Worksheet
Set analysisSheet = ActiveSheet
    lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

For a = 3 To lastRow

    If b = 3 Then
    b = 5
        Else
            b = 3
    End If

    If b = 5 Then
        a = a - 1
    End If

analysisSheet.Cells(a, b).Select
With Selection
x = 0
On Error Resume Next
x = wf.Match(Selection.Value, _
    Range("C3:E" & [C3000].End(xlUp).Row), 0)
On Error GoTo 0
If x > 0 Then
    target.Interior.Color = Cells(x, 3).Interior.Color
    Else
        Selection.Interior.Color = RGB( _
            wf.RandBetween(125, 255), wf.RandBetween(125, 255), wf.RandBetween(125, 255))
    End If
End With
Next a
End Sub

任何帮助将不胜感激！

Answer 1

假设： - 因为你只改变col C和E的颜色，所以我猜你打算只在C和E中搜索数字的存在...所以Col D在这里没有意义..

 Option Explicit

Sub colourNumbers()

Dim a, x, x1, x2, b, lastRow, lastCol As Long
Dim wf As WorksheetFunction
Dim analysisSheet As Worksheet
Dim rng1, rng2 As Range

Set wf = Application.WorksheetFunction
Set analysisSheet = ThisWorkbook.Worksheets("Sheet1")


lastRow = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row


Set rng1 = analysisSheet.Range("C3:C" & lastRow)
Set rng2 = analysisSheet.Range("E3:E" & lastRow)

lastCol = 3

For a = 3 To lastRow

    If b = 3 Then
        b = 5
    Else
        b = 3
    End If

    If b = 5 Then
        a = a - 1
    End If




x = 0
x1 = 0
x2 = 0

On Error Resume Next
x1 = wf.Match(analysisSheet.Cells(a, b).Value, rng1, 0) + 2 ' match function offset from where the array starts
On Error GoTo 0

On Error Resume Next
x2 = wf.Match(analysisSheet.Cells(a, b).Value, rng2, 0) + 2
On Error GoTo 0


If x1 = 0 And x2 > 0 Then
    x = x2
ElseIf x2 = 0 And x1 > 0 Then
    x = x1
ElseIf x2 > 0 And x1 > 0 Then
    x = x1 'pick anyone
Else
    x = 0
End If


'Debug.Print x
'Debug.Print analysisSheet.Cells(a, b).Value



If x > 0 And x <> a And b = lastCol Then
    'Debug.Print "Same"
    analysisSheet.Cells(a, b).Interior.Color = analysisSheet.Cells(x, 3).Interior.Color
    lastCol = b

ElseIf x > 0 And x = a And b <> lastCol Then
   ' Debug.Print "Same2"
    analysisSheet.Cells(a, b).Interior.Color = analysisSheet.Cells(x, 3).Interior.Color

ElseIf x > 0 And x <> a And b <> lastCol Then
    'Debug.Print "Same2"
    analysisSheet.Cells(a, b).Interior.Color = analysisSheet.Cells(x, 3).Interior.Color

Else
    analysisSheet.Cells(a, b).Interior.Color = RGB(wf.RandBetween(125, 255), wf.RandBetween(125, 255), wf.RandBetween(125, 255))

End If



Next a



End Sub

PS：在多个列中搜索键时更有效率使用Find（）方法而不是Match（）。

值的每个实例都会获得相同的颜色，新值会获得新的颜色

1 个答案: