Привет, я хочу создать код для упорядочивания данных с использованием 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 ответ1

0

Напрямую, без оптимизации и каких-либо проверок:

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"))

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .