Question

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

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

Answer 1

这可能很有趣，显然有不同的方法可以执行此操作，但是如果没有VBA，则通过条件格式获取突出显示的单元格的方法。

下面的示例显然得到了简化，但是让您知道了如何实现此目标。

1）我创建了一个带有三轮的工作表，如下所示：

2）我在B，D和F列中添加了条件格式，以查看其右侧的单元格是否具有最后输入的值。像这样：
```
=$C4=INDIRECT(CELL("ADDRESS"))
```
3）显然，您需要对C，E和G列进行反向格式化，如下所示：
```
=$B=INDIRECT(CELL("ADDRESS"))
```
4）现在，当添加第4回合时（您显然可以在tweek左右进行格式化以创建新行），然后输入一个值并点击ENTER。
li>
5）输出将如下所示：

6）Matt扮演过Sarah，Emma和John

：）

编辑1： 再次阅读您的问题，这不是您所需要的。我会尝试调整一下！

EDIT2： 请参见下面我使用VBA的尝试，并实际回答您的问题：）

1）利用VBA工作表更改事件：

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-如果是这样，它将突出显示那些单元格

我确定代码可以进行一些清理，但是它可以工作：）

Answer 2

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

这三个表分别称为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]
)

...这是您需要在第一个表的“条件格式”对话框中添加的内容：

可以很容易地将其修改为处理更多回合，但是与通过VBA使用Dictionary对象相比，这是一种复杂且效率低下的方法。

Answer 3

这就是我自己使用VBA词典的方式。它处理任何在表名中包含字符串“ Round”的表。

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

结果如下：

查找等于多列的行匹配项

3 个答案: