求大神帮忙！！！谢谢各位了

透视表

有没有大神，帮帮忙。筛选一个人，购买一样商品的方法。

乱弄的,不一样适用
Sub 遍历查询()
Dim 姓名, 商品 As String
Dim i, n As Integer
Cells.Interior.Color = xlNone
For i = 1 To Range("A1").End(xlDown).Row
n = i
姓名 = Range("A" & i)
商品 = Range("B" & i)
If 姓名 <> "" And 商品 <> "" Then
For n = i + 1 To Range("A1").End(xlDown).Row
If 姓名 = Range("A" & n) And 商品 = Range("B" & n) Then
Range("A" & n).Interior.ColorIndex = 3
Range("B" & n).Interior.ColorIndex = 3
Range("A" & i).Interior.ColorIndex = 3
Range("B" & i).Interior.ColorIndex = 3
End If
Next
End If
Next
End Sub

最省事的方法，选中要处理的区域，数据 删除重复项

操作示例

Option Explicit
Sub 字典筛选()
　Dim i, a, d, m, t
　Set d = CreateObject("scripting.dictionary")
　a = [a1].CurrentRegion.Offset(1).Resize(, 2).Value
　For i = 1 To UBound(a) - 1
　　d(a(i, 1) & Space(1) & a(i, 2)) = d(a(i, 1) & Space(1) & a(i, 2)) + 1
　Next
　For Each i In d.keys
　　If d(i) > 1 Then
　　　t = Split(i)
　　　m = m + 1
　　　a(m, 1) = t(0): a(m, 2) = t(1)
　　End If
　Next
　With [d2]
　　.Resize(UBound(a), 2).ClearContents
　　If m > 0 Then .Resize(m, 2) = a
　End With
End Sub

Option Explicit
Sub 有序后再筛选()
　Dim i, j, a, m, p
　a = [a1].CurrentRegion.Offset(1).Resize(, 2).Value
　Call qsort(a, 1, UBound(a) - 1, 1, UBound(a, 2), 1)
　For i = 1 To UBound(a) - 1
　　If a(i, 1) <> a(i + 1, 1) Then
　　　Call qsort(a, p + 1, i, 1, UBound(a, 2), 2)
　　　For j = p + 1 To i
　　　　If a(j, 2) <> a(j + 1, 2) Or j = i Then
　　　　　If j - p > 1 Then m = m + 1: a(m, 1) = a(j, 1): a(m, 2) = a(j, 2)
　　　　　p = j
　　　　End If
　　　Next
　　　p = i
　　End If
　Next
　With [d2]
　　.Resize(UBound(a), 2).ClearContents
　　If m > 0 Then .Resize(m, 2) = a
　End With
End Sub
Function qsort(arr, first, last, left, right, key)
　Dim i As Long, j As Long, k As Long, x, t
　i = first: j = last: x = arr((first + last) \ 2, key)
　While i <= j
　　While arr(i, key) < x: i = i + 1: Wend
　　While x < arr(j, key): j = j - 1: Wend
　　If i <= j Then
　　　For k = left To right
　　　　t = arr(i, k): arr(i, k) = arr(j, k): arr(j, k) = t
　　　Next
　　　i = i + 1: j = j - 1
　　End If
　Wend
　If first < j Then qsort arr, first, j, left, right, key
　If i < last Then qsort arr, i, last, left, right, key
End Function

字典最容易