- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-10-17 13:53 ½s¿è
ÁÂÁÂ Hsieh «e½ú
ÁÂÁÂ n7822123 «e½ú
¥H¤U¤ß±oµù¸Ñ,Àµ½Ð«e½úÌ«ü¥¿»P«ü¾É!
Option Explicit
Sub TEST()
Dim Arr, Brr, C&, i&, R&, T, Y, Z, Q
Set Y = CreateObject("Scripting.Dictionary")
Sheets("Sheet5").Cells = ""
'¡ô¥O ¤u§@ªí "Sheet5" ©Ò¦³Àx¦sÓ³£¬OªÅ¦r¤¸
''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Sheets("Sheet1")
Set Brr = .[A1].CurrentRegion
'¡ô¥O Brr¬O [A1]¬Û¾F«DªÅ®æ©Ò¦ê³s°_¨ÓªºÀx¦s®æ,ÂX®i¨ì¤è¥¿°Ï°ìªº³Ì¤p½d³òÀx¦s®æ
C = .[A1].End(xlToRight).Column
'¡ô¥OC¬O¦¹ªíªºÄæ¼Æ
R = .[A1].End(xlDown).Row
'¡ô¥OR¬O¦¹ªíªº¦C¼Æ
End With
For i = 1 To R
'¡ô³]°j°é§â¤@ºû°}¦CˤJ¦r¨å¸Ì·íitem
T = Brr(i, 1)
Q = Brr(i, 2)
Arr = Brr(i, 1).Resize(, C)
Arr = Application.Transpose(Application.Transpose(Arr))
Y(T & "|" & Q) = Arr
'¡ô¥O¦¹KEYªºITEM¬OArr¤@ºû°}¦C
Next
With Sheet5
.[A1].Resize(Y.Count, C) = Application.Transpose(Application.Transpose(Y.items))
'¡ô§âY¦r¨åªº¤@ºû°}¦CITEMȱq[A1]¶}©l¶K¤J
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Sheets("Sheet2")
Set Brr = .Range(.[D1], .[A1].End(xlDown))
C = .[A1].End(xlToRight).Column - 2
R = .[A1].End(xlDown).Row
End With
For Each Z In Y.KEYS
'¡ô³]°j°é§âitemªº¤@ºû°}¦C§ïÅÜ°}¦C¤j¤p
'³o¸Ì«Ü«n!
'¦]¬°¦pªG³Ì«áÂà¸m¶K¤W®É!¦r¨åITEMªº¶°¦X¤£¬O¤è¥¿ªº
'´N¨S¿ìªkÂà¸m¶K¤W
Y(Z) = Array("", "")
Next
For i = 1 To R
'¡ô³]°j°é§â¤@ºû°}¦CˤJ¦r¨å¸Ì·íitem
T = Brr(i, 1)
Q = Brr(i, 2)
Arr = Brr(i, 3).Resize(, C)
Arr = Application.Transpose(Application.Transpose(Arr))
If Y.Exists(T & "|" & Q) Then
'¡ô¦pªG²Õ¦X¦r¦ê¦b¦r¨å¸Ì¦³!
Y(T & "|" & Q) = Arr
'¡ô±ø¥ó¦¨¥ß´N¥O¦¹KEYªºITEM¬OArr¤@ºû°}¦C
End If
Next
With Sheet5
.[I1].Resize(Y.Count, C) = Application.Transpose(Application.Transpose(Y.items))
'¡ô§âY¦r¨åªº¤@ºû°}¦CITEMȱq[I1]¶}©l¶K¤J
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Sheets("Sheet3")
Set Brr = .Range(.[K1], .[A1].End(xlDown))
C = .[A1].End(xlToRight).Column
R = .[A1].End(xlDown).Row
End With
For Each Z In Y.KEYS
'¡ô³]°j°é§âitemªº¤@ºû°}¦C§ïÅÜ°}¦C¤j¤p
'³o¸Ì«Ü«n!
'¦]¬°¦pªG³Ì«áÂà¸m¶K¤W®É!¦r¨åITEMªº¶°¦X¤£¬O¤è¥¿ªº
'´N¨S¿ìªkÂà¸m¶K¤W
Y(Z) = Split(",,,,,,,,,,", ",")
Next
For i = 1 To R
'¡ô³]°j°é§â¤@ºû°}¦CˤJ¦r¨å¸Ì·íitem
T = Brr(i, 1)
Q = Brr(i, 2)
Arr = Brr(i, 1).Resize(, C) '
Arr = Application.Transpose(Application.Transpose(Arr))
If Y.Exists(T & "|" & Q) Then
'¡ô¦pªG²Õ¦X¦r¦ê¦b¦r¨å¸Ì¦³!
Y(T & "|" & Q) = Arr
'¡ô±ø¥ó¦¨¥ß´N¥O¦¹KEYªºITEM¬OArr¤@ºû°}¦C
End If
Next
With Sheet5
.[K1].Resize(Y.Count, C) = Application.Transpose(Application.Transpose(Y.items))
'¡ô§âY¦r¨åªº¤@ºû°}¦CITEMȱq[K1]¶}©l¶K¤J
End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Sheets("Sheet4")
Set Brr = .Range(.[R1], .[A1].End(xlDown))
C = .[A1].End(xlToRight).Column - 2
R = .[A1].End(xlDown).Row
End With
For Each Z In Y.KEYS
'¡ô³]°j°é§âitemªº¤@ºû°}¦C§ïÅÜ°}¦C¤j¤p
'³o¸Ì«Ü«n!
'¦]¬°¦pªG³Ì«áÂà¸m¶K¤W®É!¦r¨åITEMªº¶°¦X¤£¬O¤è¥¿ªº
'´N¨S¿ìªkÂà¸m¶K¤W
Y(Z) = Split(",,,,,,,,,,,,,,,", ",")
Next
For i = 1 To R
T = Brr(i, 1)
Q = Brr(i, 2)
Arr = Brr(i, 3).Resize(, C)
Arr = Application.Transpose(Application.Transpose(Arr))
If Y.Exists(T & "|" & Q) Then
'¡ô¦pªG²Õ¦X¦r¦ê¦b¦r¨å¸Ì¦³!
Y(T & "|" & Q) = Arr
'¡ô±ø¥ó¦¨¥ß´N¥O¦¹KEYªºITEM¬OArr¤@ºû°}¦C
End If
Next
With Sheet5
.[V1].Resize(Y.Count, C) = Application.Transpose(Application.Transpose(Y.items))
'¡ô§âY¦r¨åªº¤@ºû°}¦CITEMȱq[V1]¶}©l¶K¤J
End With
Set Arr = Nothing
Set Brr = Nothing
Set Y = Nothing
End Sub |
|