查找等于多列的行的匹配项

Find matches of rows equalling over multiple columns

我有一个工作表,我在其中安排玩家互相玩的游戏。每轮都有球员姓名或号码的列。请参阅示例图片。Example Image

我所追求的是一种检查玩家之前是否玩过同一玩家并突出显示该玩家姓名的方法。所以查找一个玩家和他的对手,看看它是否与其他列中的行相匹配。

好吧,这可能很有趣,显然有不同的方法可以做到这一点,但如果没有 VBA,获得突出显示单元格的方法是通过条件格式。

下面的示例显然经过了简化,但可以让您了解如何处理这个问题。

  • 1) 我创建了一个 sheet 三轮如下:

  • 2) 我在 B、D 和 F 列中添加了条件格式,以查看其右侧的单元格中是否包含最后输入的值。像这样:

    =$C4=INDIRECT(CELL("ADDRESS"))
    
  • 3) 显然您需要像这样对 C、E 和 G 列进行反向格式化:

    =$B=INDIRECT(CELL("ADDRESS"))
    
  • 4) 现在,当添加第 4 轮时(当您想要创建新行时,您显然可以调整格式),您输入一个值并点击 ENTER

  • 5) 输出会像这样:

  • 6) Matt 扮演过 Sarah、Emma 和 John

:)

EDIT1: 再次阅读您的问题,这不是您所需要的。我会尝试调整一下!

EDIT2: 请参阅下面我使用 VBA 的尝试,并实际回答您的问题:)

  • 1) 利用VBA工作sheet改变事件:

    Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim Player As String, Opponent As String
    Dim C As Range
    
    'Check if a player name has been entered
    On Error Resume Next
    If InStr(1, Sheets(1).Cells(2, Target.Column), "Player", vbTextCompare) <> 0 Then
        If Right(Sheets(1).Cells(2, Target.Column).Value, 1) = "A" Then
            Opponent = Target.Offset(0, 2).Value
        ElseIf Right(Sheets(1).Cells(2, Target.Column).Value, 1) = "B" Then
            Opponent = Target.Offset(0, -2).Value
        End If
        Player = Target.Value
        If Opponent <> "" And Player <> "" Then
            Sheets(1).UsedRange.Cells.Interior.Pattern = xlNone
            With Sheets(1).UsedRange
                Set C = .Find(Opponent, Lookat:=xlWhole)
                If Not C Is Nothing Then
                    firstaddress = C.Address
                    Do
                        If C.Offset(0, 2).Value = Player Or C.Offset(0, -2).Value = Player Then
                            C.Interior.ColorIndex = 37
                        End If
                        Set C = .FindNext(C)
                    If C Is Nothing Then
                        GoTo Donefinding
                    End If
                    Loop While C.Address <> firstaddress
                End If
    Donefinding:
            End With
        End If
    End If
    
    End Sub
    
  • 2) 将此粘贴到 Sheet(1) 代码中

  • 3) 确保第 2 行的值是 "Player A" 或 "Player B"

此代码的作用:

  • A - 它检查您是否为玩家 A 或玩家 B 添加了名字
  • B - 如果是这样,它将首先清除之前 运行
  • 中完成的所有格式
  • C - 然后利用.findnext获取刚刚添加的玩家的任何匹配
  • D - 根据 A 或 B 将检查任何找到的单元格旁边的对手是否相同
  • E - 如果是这样,它将突出显示那些单元格

我确定代码可以进行一些清理,但它确实有效:)

您可以使用条件格式来执行此操作。见下图:

这三个Table分别叫做Round1、Round2、Round3。我添加了一个辅助列来保存条件格式公式,并将它们垂直堆叠以便我可以截取适合此处的屏幕截图。

这是公式。请注意,它们必须是使用 Ctrl+Shift+Enter 键盘快捷键输入的数组:

H2:

=OR(
         [@[Player A]]&[@[Player B]]=Round2[Player A]&Round2[Player B],[@[Player B]]&[@[Player A]]=Round2[Player A]&Round2[Player B],
         [@[Player A]]&[@[Player B]]=Round3[Player A]&Round3[Player B],[@[Player B]]&[@[Player A]]=Round3[Player A]&Round3[Player B]
)

H8:

=OR(
         [@[Player A]]&[@[Player B]]=Round1[Player A]&Round1[Player B],[@[Player B]]&[@[Player A]]=Round1[Player A]&Round1[Player B],
         [@[Player A]]&[@[Player B]]=Round3[Player A]&Round3[Player B],[@[Player B]]&[@[Player A]]=Round3[Player A]&Round3[Player B]
)

H14:

=OR(
         [@[Player A]]&[@[Player B]]=Round1[Player A]&Round1[Player B],[@[Player B]]&[@[Player A]]=Round1[Player A]&Round1[Player B],
         [@[Player A]]&[@[Player B]]=Round2[Player A]&Round2[Player B],[@[Player B]]&[@[Player A]]=Round2[Player A]&Round2[Player B]
)

...这是您需要为第一个 Table 添加到“条件格式”对话框的内容:

这可以很容易地修改以处理更多轮次,但与通过 VBA 使用字典对象相比,这是一种复杂且效率低下的方法。

这就是我自己的做法,使用 VBA 词典。它处理在 Table 名称中包含字符串 "Round" 的任何 Table。

Option Explicit

Sub HighlightDuplicates()

Dim lo As ListObject
Dim lr As ListRow
Dim dic As Object
Dim ws As Worksheet
Dim sTemp As String
Dim sPlayerB As String
Dim sPlayerA As String

Set dic = CreateObject("Scripting.Dictionary")

For Each ws In ActiveWorkbook.Worksheets
    For Each lo In ws.ListObjects
        If InStr(lo.Name, "Round") Then
            lo.Range.Interior.Pattern = xlNone
            For Each lr In lo.ListRows
                sPlayerA = UCase(Intersect(lr.Range, lo.ListColumns("Player A").Range))
                sPlayerB = UCase(Intersect(lr.Range, lo.ListColumns("Player B").Range))
                If sPlayerA > sPlayerB Then
                    sTemp = sPlayerB
                    sPlayerB = sPlayerA
                    sPlayerA = sTemp
                End If
                sTemp = sPlayerA & "|" & sPlayerB
                If Not dic.exists(sTemp) Then
                    dic.Add sTemp, False
                Else
                    dic(sTemp) = True
                End If
            Next lr
        End If
    Next lo
Next ws


For Each ws In ActiveWorkbook.Worksheets
    For Each lo In ws.ListObjects
        If InStr(lo.Name, "Round") Then
            For Each lr In lo.ListRows
                sPlayerA = UCase(Intersect(lr.Range, lo.ListColumns("Player A").Range))
                sPlayerB = UCase(Intersect(lr.Range, lo.ListColumns("Player B").Range))
                If sPlayerA > sPlayerB Then
                    sTemp = sPlayerB
                    sPlayerB = sPlayerA
                    sPlayerA = sTemp
                End If
                sTemp = sPlayerA & "|" & sPlayerB
                If dic(sTemp) Then
                    Intersect(lr.Range, lo.ListColumns("Player A").Range).Interior.Color = vbYellow
                    Intersect(lr.Range, lo.ListColumns("Player B").Range).Interior.Color = vbYellow
                End If
            Next lr
        End If
    Next lo
Next ws

End Sub

结果如下: