查找等于多列的行的匹配项
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
结果如下:
我有一个工作表,我在其中安排玩家互相玩的游戏。每轮都有球员姓名或号码的列。请参阅示例图片。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
结果如下: