为值的每个实例分配颜色 [英] Assigning Colours to each Instance of a value

问题描述

我正在尝试制作一个程序，其中在两个设置的列中有两组数字，例如发送方和接收方编号.我想为值的每个实例分配该数字唯一的颜色.但是，如果发件人号码位于收件人列中，反之亦然，则两列之间的颜色应该相同.

I am trying to make a program in which there are two sets of numbers in two set columns, like sender and receiver numbers. I want to assign each instance of a value a colour that is unique to that number. However if a sender number is in the receiver column and vice versa, the two should have the same colour between the two columns.

到目前为止，我可以在一个专栏中使用它.我尝试过使用列变量:

I have this so far which works within one column. I have tried playing with the column variables:

Private Sub Worksheet_Change(ByVal target As Range)
Set wf = Application.WorksheetFunctio
If target.Cells.Count = 1 Then
    If target.Column = 3 Then
    x = 0
    On Error Resume Next
    x = wf.Match(target.Value, _
        Range("C1").Resize(target.Row - 1), 0)
    On Error GoTo 0
    If x > 0 Then
        target.Interior.Color = Cells(x, 3).Interior.Color
        Else
            target.Interior.Color = RGB( _
                wf.RandBetween(125, 255), wf.RandBetween(125, 255), wf.RandBetween(125, 255))
        End If
    End If
End If

If target.Cells.Count = 1 Then
    If target.Column = 5 Then
    x = 0
    On Error Resume Next
    x = wf.Match(target.Value, _
        Range("e1").Resize(target.Row - 1), 0)
    On Error GoTo 0

    If x > 0 Then
        target.Interior.Color = Cells(x, 5).Interior.Color
        Else
            target.Interior.Color = RGB( _
                wf.RandBetween(125, 255), wf.RandBetween(125, 255), wf.RandBetween(125, 255))
        End If
    End If
End If
End Sub

推荐答案

以下Change事件将使用函数可在C或E列中的其他任何位置(不一定仅在其上方的行中)获取该值的现有颜色.

The following Change event will set the colour of any new value entered into either column C or E, utilising the FindColour function to obtain the existing colour for that value anywhere else in column C or E (not necessarily only in rows above it).

ResetThem子例程清除C和E列上的所有格式，然后从头开始重置颜色. (如果您已经在那些尚未着色的列中有数据，则很有用.)

The ResetThem subroutine clears out all formatting on columns C and E and then resets the colours starting from scratch. (Useful if you already have data in those columns which hasn't yet been coloured.)

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count = 1 Then
        If Target.Column = 3 Or Target.Column = 5 Then
            Target.Interior.Color = FindColour(Target.Value)
        End If
    End If
End Sub

Function FindColour(v As Variant) As Long
    Set wf = Application.WorksheetFunction
    On Error Resume Next
    x = 0
    'See if value exists in column C
    x = wf.Match(v, Range("C:C"), 0)
    If x > 0 Then
        If Cells(x, "C").Interior.Color <> vbWhite Then
            FindColour = Cells(x, "C").Interior.Color
            Exit Function
        End If
    End If
    'See if value exists in column E
    x = wf.Match(v, Range("E:E"), 0)
    If x > 0 Then
        If Cells(x, "E").Interior.Color <> vbWhite Then
            FindColour = Cells(x, "E").Interior.Color
            Exit Function
        End If
    End If
    'Assign a random colour
    FindColour = RGB(wf.RandBetween(125, 255), wf.RandBetween(125, 255), wf.RandBetween(125, 255))
End Function

Sub ResetThem()
    With Columns("C").Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Columns("E").Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Dim r As Long
    'Starting at row 2 to avoid assigning a colour to headings
    ' (change "2" to "1", or some other number, as appropriate)
    For r = 2 To Cells(Rows.Count, "C").End(xlUp).Row
        If Not IsEmpty(Cells(r, "C").Value) Then
            Cells(r, "C").Interior.Color = FindColour(Cells(r, "C").Value)
        End If
    Next r
    For r = 2 To Cells(Rows.Count, "E").End(xlUp).Row
        If Not IsEmpty(Cells(r, "E").Value) Then
            Cells(r, "E").Interior.Color = FindColour(Cells(r, "E").Value)
        End If
    Next r
End Sub

---

一个潜在的问题是，如果在同一列中其下一个单元格中已经存在相同值而另一列中不存在该值时，则将该值输入到单元格中，则将分配新的颜色.有很多方法可以解决该问题，但是我不确定它是否会在您遇到的情况下发生，所以我没有考虑到它.

---

One potential problem is that, if a value is entered into a cell when that same value already exists in a cell below it in the same column but doesn't exist in the other column, a new colour will be assigned. There are ways around that issue, but I'm not sure whether it will occur in your situation, so I haven't catered for it.

这篇关于为值的每个实例分配颜色的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！