☰

根据第一列 VBA 清除重复项

tag-icon • tag-icon microsoft-excel vba macros
根据第一列 VBA 清除重复项

嗨，有没有办法根据名称清除重复项？上次我已经问过如何清除重复项，以下是输出

Col 2    | Col 1
Person 1 | 1. Question 1
         | 2. Question 2
         | 3. Question 3
-------------------------
Person 2 | 1. Question 1
         | 2. Question 2
         | 3. Question 3
-------------------------
Person 3 | 1. Question 1
         | 2. Question 2
         | 3. Question 3

我添加了另一列，即第 3 列，可以在其中查看状态。

Col 2    | Col 1         | Col 3
Person 1 | 1. Question 1 | CLEAN
         | 2. Question 2 | CLEAN
         | 3. Question 3 | CLEAN
-------------------------
Person 2 | 1. Question 1 | CLEAN
         | 2. Question 2 | CLEAN
         | 3. Question 3 | CLEAN
-------------------------
Person 3 | 1. Question 1 | CLEAN
         | 2. Question 2 | CLEAN
         | 3. Question 3 | CLEAN

我希望它是这样的：

Col 2    | Col 1         | Col 3
Person 1 | 1. Question 1 | CLEAN
         | 2. Question 2 | 
         | 3. Question 3 | 
-------------------------
Person 2 | 1. Question 1 | CLEAN
         | 2. Question 2 | 
         | 3. Question 3 | 
-------------------------
Person 3 | 1. Question 1 | CLEAN
         | 2. Question 2 | 
         | 3. Question 3 |

顺便说一下，这是代码：

Sub RemoveDups(src As Range, dst As Range)
Dim i As Integer, j As Integer, tmp, temp()
' Copy source range
temp = src.Value
' Sort data
For i = LBound(temp, 1) To UBound(temp, 1) - 1
    For j = i + 1 To UBound(temp, 1)
        If (temp(i, 2) > temp(j, 2)) Or ((temp(i, 2) = temp(j, 2)) And (temp(i, 1) > temp(j, 1))) Then
            tmp = temp(i, 1)
            temp(i, 1) = temp(j, 1)
            temp(j, 1) = tmp
            tmp = temp(i, 2)
            temp(i, 2) = temp(j, 2)
            temp(j, 2) = tmp
        End If
    Next j
Next i
' Clear vertical dups
For i = UBound(temp, 1) - 1 To LBound(temp, 1) Step -1
    If temp(i + 1, 2) = temp(i, 2) Then
        temp(i + 1, 2) = ""
    End If
Next i
' Swap columns
For i = LBound(temp, 1) To UBound(temp, 1)
    tmp = temp(i, 1)
    temp(i, 1) = temp(i, 2)
    temp(i, 2) = tmp
Next i
' Store result
dst.Value = temp
End Sub

我尝试添加'清除垂直重复

If temp(i + 1, 3) = temp(i, 3) Then
        temp(i + 1, 3) = ""
End If

但它给了我这个输出：

Col 2    | Col 1         | Col 3
Person 1 | 1. Question 1 | CLEAN
         | 2. Question 2 | 
         | 3. Question 3 | 
-------------------------
Person 2 | 1. Question 1 | 
         | 2. Question 2 | 
         | 3. Question 3 | 
-------------------------
Person 3 | 1. Question 1 | 
         | 2. Question 2 | 
         | 3. Question 3 |

帮帮我！谢谢！

答案1

在 For 语句之后立即在垂直清除块中注入 3 行代码。

' Clear vertical dups
For i = UBound(temp, 1) - 1 To LBound(temp, 1) Step -1 
    If ((temp(i + 1, 2) = temp(i, 2)) And (temp(i + 1, 3) = temp(i, 3))) Then
        temp(i + 1, 3) = ""
    End If
    If temp(i + 1, 2) = temp(i, 2) Then
        temp(i + 1, 2) = ""
    End If
Next i

相关内容