救救孩子吧,这个Excel的数据怎么用VBA解决?

发布网友发布时间：2024-09-29 03:47

共1个回答

热心网友时间：2024-09-30 04:06

Sub test1()
Dim i&, j&, arr, brr(), crr, r&, a, b, d As Object
r = Cells(Rows.Count, 1).End(xlUp).Row
ReDim brr(1 To r - 1)
For i = 2 To r
arr = Application.Transpose(Application.Transpose(Range("a" & i & ":d" & i)))
a = Join(arr, "|")
brr(i - 1) = a
Next
Set d = CreateObject("scripting.dictionary")
For Each b In brr
d(b) = ""
Next
arr = d.keys
For i = 1 To UBound(arr) + 1
Cells(i + 1, 10).Resize(1, 4) = Split(arr(i - 1), "|")
Cells(i + 1, 10) = Val(Cells(i + 1, 10))
d.RemoveAll
For j = 1 To r - 1
a = Cells(j + 1, 5)
If arr(i - 1) = brr(j) And a <> "" Then
d(a) = ""
End If
Next
crr = d.keys
Cells(i + 1, 14) = Join(crr, "、")
d.RemoveAll
For j = 1 To r - 1
a = Cells(j + 1, 6)
If arr(i - 1) = brr(j) And a <> "" Then
d(a) = ""
End If
Next
crr = d.keys
Cells(i + 1, 15) = Join(crr, "、")
Next
[j1:o1] = [a1:f1].Value
[j:j].NumberFormatLocal = "yyyy-mm-dd"
End Sub