☰

Excel VBA 合并重复项并添加列值

tag-icon • tag-icon microsoft-excel vba macros
Excel VBA 合并重复项并添加列值

你好，我想创建一个代码来使用 vba 排列数据，但我不知道该怎么做。

我有如下数据

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

我希望输出看起来像这样

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

我不知道如何使用 vba 来实现这一点。请帮助我。

谢谢。

答案1

直接，无需优化和任何检查：

Sub ReSort(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

src如果您想覆盖，则可能等于dst。例如，

Call ReSort(Range("A1:B9"), Range("A1:B9"))

相关内容