【发布时间】:2015-09-19 13:57:37
【问题描述】:
【问题讨论】:
-
[python] 还是 [excel] ? Aggregate, Collate and Transpose rows into columns 的可能重复项
-
在 Excel 中抱歉。我已经尝试过您建议的脚本,但很遗憾,我无法让它满足我的需求。
【问题讨论】:
Sheet1 中有这样的数据:
运行这个宏:
Sub dural()
Dim s1 As Worksheet, s2 As Worksheet
Dim i As Long, j As Long, st As String
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
s1.Range("A:A").Copy s2.Range("A1")
s2.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
For Each r In s2.Range("A:A")
v = r.Value
If v = "" Then Exit Sub
For Each rr In s1.Range("A:A")
vv = rr.Value
If vv = "" Then Exit For
If v = vv Then
If r.Offset(0, 1).Value = "" Then
r.Offset(0, 1).Value = rr.Offset(0, 1).Value
Else
r.Offset(0, 1).Value = r.Offset(0, 1).Value & " ," & rr.Offset(0, 1).Value
End If
End If
Next rr
Next r
End Sub
将在 Sheet2 中生成:
注意:
Sheet1中的数据不需要排序。
【讨论】:
试试这个:
Sub Test()
Dim objIds, arrData, i, strId
Set objIds = CreateObject("Scripting.Dictionary")
arrData = Range("A1:B8").Value ' put here your source range
For i = LBound(arrData, 1) To UBound(arrData, 1)
If IsEmpty(objIds(arrData(i, 1))) Then
objIds(arrData(i, 1)) = arrData(i, 2)
Else
objIds(arrData(i, 1)) = objIds(arrData(i, 1)) & ", " & arrData(i, 2)
End If
Next
i = 1 ' first row for output
For Each strId In objIds
Cells(i, 3) = strId ' first column for output
Cells(i, 4) = objIds(strId) ' second column for output
i = i + 1
Next
End Sub
【讨论】:
这就是你所需要的,不需要任何东西排序:
Sub Sam()
Dim c&, i&, d$, s$, v, w
v = [a1].CurrentRegion.Resize(, 2)
ReDim w(1 To UBound(v), 1 To 2)
For i = 1 To UBound(v)
d = ", "
If s <> v(i, 1) Then d = "": c = c + 1: s = v(i, 1): w(c, 1) = s
w(c, 2) = w(c, 2) & d & v(i, 2)
Next
[d1:e1].Resize(UBound(w)) = w
End Sub
这段代码非常快。如果您要处理大型列表,这里的效率将不胜感激。
您可以通过调整过程顶部和底部方括号中的地址来管理源数据的位置和输出应写入的位置。
【讨论】: