楼主
amulee |
Q：如何用VBA提取不重复的类别和子类别并排序？
A：如附件，B2：C298有许多类别和子类别，如何按照右边的效果图提取不重复的类别和子类别并排序。请参考以下代码：
- Sub 数据处理()
- Dim ArrYS, ArrJG, i&, k&, j&, temp
- Dim d As New Dictionary
- ArrYS = Range("B2:C" & Range("B1048576").End(xlUp).Row)
- k = 0
- ReDim ArrJG(1 To 3, 1 To 1)
- '剔除重复
- For i = 1 To UBound(ArrYS, 1)
- If Not d.Exists(ArrYS(i, 1) & ArrYS(i, 2)) Then
- k = k + 1
- d(ArrYS(i, 1) & ArrYS(i, 2)) = k
- ReDim Preserve ArrJG(1 To 3, 1 To k)
- ArrJG(2, k) = ArrYS(i, 1)
- ArrJG(3, k) = ArrYS(i, 2)
- End If
- Next i
- '排序。双关键字。
- For i = 1 To UBound(ArrJG, 2)
- For j = i + 1 To UBound(ArrJG, 2)
- If StrComp(ArrJG(2, j), ArrJG(2, i), vbTextCompare) = -1 Then
- temp = ArrJG(2, i)
- ArrJG(2, i) = ArrJG(2, j)
- ArrJG(2, j) = temp
- temp = ArrJG(3, i)
- ArrJG(3, i) = ArrJG(3, j)
- ArrJG(3, j) = temp
- Else
- If StrComp(ArrJG(2, j), ArrJG(2, i), vbBinaryCompare) = 0 Then
- If StrComp(ArrJG(3, j), ArrJG(3, i), vbTextCompare) = -1 Then
- temp = ArrJG(2, i)
- ArrJG(2, i) = ArrJG(2, j)
- ArrJG(2, j) = temp
- temp = ArrJG(3, i)
- ArrJG(3, i) = ArrJG(3, j)
- ArrJG(3, j) = temp
- End If
- End If
- End If
- Next j
- Next i
- For i = UBound(ArrJG, 2) To 1 Step -1
- ArrJG(1, i) = i
- If i > 1 Then
- If ArrJG(2, i) = ArrJG(2, i - 1) Then ArrJG(2, i) = ""
- End If
- Next i
- Range("I2").Resize(UBound(ArrJG, 2), 3) = Application.Transpose(ArrJG)
- End Sub
 A-VBA-用代码列出类别和子类别.rar
|