- Sub 转换()
- Dim d, Arr, s$, i&, j&, m, n, d1
- Set d = CreateObject("Scripting.Dictionary")
- Set d1 = CreateObject("Scripting.Dictionary")
- Arr = Sheets("SQL").[A1].CurrentRegion
- ReDim brr(1 To UBound(Arr), 1 To 7)
- For i = 2 To UBound(Arr)
- s = Arr(i, 1) & Arr(i, 2) & Arr(i, 3) & Arr(i, 4) & Arr(i, 5) & Arr(i, 7)
- If Not d.Exists(s) Then
- m = m + 1
- d(s) = m
- d1(s) = Arr(i, 6)
- For j = 1 To 5
- brr(m, j) = Arr(i, j)
- Next
- brr(m, 7) = d1(s): brr(m, 6) = Arr(i, 7)
- Else
- d1(s) = d1(s) & "," & Arr(i, 6)
- n = d(s)
- brr(n, 7) = d1(s): brr(n, 6) = Arr(i, 7)
- End If
- Next
- [A2:AA65536].ClearContents
- [A2].Resize(m, 7) = brr
- End Sub
复制代码 |