2,461
社区成员
发帖
与我相关
我的任务
分享
Option Explicit
Sub 多项数据处理成一行多列()
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")
Dim i As Long
i = 3
Do While Sheet1.Cells(i, 1) <> ""
Dim j As Long
For j = 3 To 16
If Sheet1.Cells(i, j) <> "" Then
Dim strKey As String
strKey = Sheet1.Cells(i, j) & "," & Sheet1.Cells(i, 1) & "," & Sheet1.Cells(1, j)
Dim strValue As String
strValue = Sheet1.Cells(i, 2)
If dict.exists(strKey) Then
dict.Item(strKey) = dict.Item(strKey) & "," & strValue
Else
dict.Add strKey, strValue
End If
End If
Next
i = i + 1
Loop
i = 2
Dim varKey As Variant
For Each varKey In dict
Dim arrKey() As String
arrKey = Split(varKey, ",")
Sheet2.Cells(i, 1) = arrKey(0)
Sheet2.Cells(i, 2) = arrKey(1)
Sheet2.Cells(i, 3) = dict(varKey)
Sheet2.Cells(i, 4) = arrKey(2)
i = i + 1
Next
MsgBox "done!"
End Sub
下载地址:
链接:https://pan.baidu.com/s/1_jpRGo3wd_nkunIJ7JON9A
提取码:riqz
运行示例: