ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] §Q¥ÎEXCEL¥¨¶°¸ê®Æ³B²z

[µo°Ý] §Q¥ÎEXCEL¥¨¶°¸ê®Æ³B²z

¦p¦ó­×§ï¥H¤U§», §âµ²ªG±qÄæ¦ì"­q³f³æ" ¶}©l¶K¦bresult ¤W?

Sub nn()
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
With Sheet1
For Each a In .Range(.[A2], .[A65536].End(xlUp))
mystr = a.Offset(, 1) & a.Offset(, 2) & a.Offset(, 3) & a.Offset(, 4) & a.Offset(, 5)
¡@ If IsEmpty(d(mystr)) Then
¡@¡@¡@ar = a.Resize(, 6).Value
¡@¡@¡@d(mystr) = a.Resize(, 6).Value
¡@¡@¡@d1(mystr) = 1
¡@¡@¡@Else
¡@¡@¡@ar = d(mystr)
¡@¡@¡@ar(1, 6) = ar(1, 6) + Val(a.Offset(, 5))
¡@¡@¡@d1(mystr) = d1(mystr) + 1
¡@¡@End If
Next
End With
With Sheet2
¡@ .[A2:G65536] = ""
¡@ .[A2].Resize(d.Count, 6) = Application.Transpose(Application.Transpose(d.items))
¡@ .[G2].Resize(d.Count, 1) = Application.Transpose(d1.items)
End With
End Sub

PICK.rar (11.41 KB)

¤w­×§ï¦¨³o¥y, ¥i¥H¹F¨ì¥Ø¼Ð, ¦ý³v¦æ¶K¤W, ³t«×¤ÓºC, ¥i¥H²¤Æ¶Ü

For i = 1 To D.Count
.Cells(1 + i, 1).Resize(1, 1) = Application.Transpose(Application.Transpose(D.items))(i, 4)
NEXT

TOP

¸ÕÅç«á. ³£¬O .Dictionary ¸û§Ö, Split(Text, "-")<< ¸û¯Ó®É, ÁÂÁ¦U¤j¤j!

TOP

        ÀR«ä¦Û¦b : §Ú­Ì³Ì¤jªº¼Ä¤H¤£¬O§O¤H¡D¥i¯à¬O¦Û¤v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD