- ©«¤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-18 08:51 ½s¿è
¦U¦ì«e½ú¦n
¤µ¤Ñ½m²ß°}¦C»y¦r¨å
¤ß±oµù¸Ñ¦p¤U:
Option Explicit
Sub TEST()
Dim Arr, Brr(1 To 999, 1 To 12), Crr, c&, i&, x&, R&, T, Y, N, j, Z
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY¬O¦r¨å
Set Arr = [¤u§@ªí1!A1].CurrentRegion
'¡ô¥O Brr¬O [A1]¬Û¾F«DªÅ®æ©Ò¦ê³s°_¨ÓªºÀx¦s®æ,ÂX®i¨ì¤è¥¿°Ï°ìªº³Ì¤p½d³òÀx¦s®æ
c = [¤u§@ªí1!A1].End(xlToRight).Column
'¡ô¥OC¬O¦¹ªíªºÄæ¼Æ
R = [¤u§@ªí1!A1].End(xlDown).Row
'¡ô¥OR¬O¦¹ªíªº¦C¼Æ
For i = 2 To R
'¡ô³]°j°é±q2¶}©l¨ì¦¹ªíªº¦C¼Æ
T = Arr(i, 3)
'¡ô¥OT¬O CÄ涵¥Ø¦WºÙ
Crr = Y(T & "|") '#1
'¡ô¥OCrr¬OY¦r¨å¸Ìªº ¶µ¥Ø¦WºÙ&"|"¦r¦ê ¬°keyªºitem
Y(T) = Y(T) + 1 '@1
'¡ô¥O¶µ¥Ø¦WºÙ ¬°key,item²Ö¥[1,³o¬O«á±¥Î¨Ó«ü©w°}¦C¦C¼Æªº
',¦p @1 ¼Ðµù
If Not IsArray(Crr) Then
'¡ô¦pªG§P©w Crr ÁÙ¤£¬O°}¦C
Y(T) = Y(T) + 1
'¡ô¥O¶µ¥Ø¦WºÙ ¬°key,item²Ö¥[1,³o¬O«á±¥Î¨Ó«ü©w°}¦C¦C¼Æªº
',¦p @2 ¼Ðµù!³o¸Ì+1¬O¬°¤FªÅ¥X¤@¦Cµ¹¼ÐÃD¦C¥Îªº
Crr = Brr
'¡ô¥OCrrÅܦ¨¤@Ó¤WzBrr(1 To 999, 1 To 12)ªÅ°}¦C
',©Ò¥HBrr±qÀY¨ì§À³£¬O¤@ӪŪº®e¾¹
End If
For j = 1 To 12
'³]°j°é±N¸ê®Æ±a¤JCrr°}¦C
Crr(Y(T), j) = Arr(i, j) '@1
If Y(T) = 2 Then '@2
'¡ô¦pªG¦¹®Éªº°}¦C¼g¤J¬O¦b²Ä2¦C
Crr(1, j) = Arr(1, j)
'¡ô´N¤@°_§â¼ÐÃD¦C¼g¶i¥h°}¦C¸Ì
End If
Next j
Y(T & "|") = Crr '#1
'¡ô¥O ¶µ¥Ø¦WºÙ&"|"¦r¦ê ¬°key ,¥OCrr¬°¥¦ªºitem,
Next
'¡ô°j°éÁ`µ²:
'°j°é·|Åý¦r¨å¸Ì¸Ë¶i¼Æ¦r.¦r¦ê.°}¦C
Workbooks.Add
For Each Z In Y.KEYS
'¡ô³]¶¶°j°é¥OZ¬OY¦r¨å¸Ìkeyªº¤@û
If InStr(Z, "|") Then
'¡ô¦pªGZ³okey¦r¦ê¸Ì¦³ "|" ²Å¸¹,¥Nªí¥Lªºitem¬O°}¦C
'§ÚÌ´N¬On½Õ¥X°}¦C©ñ¦b·s¤u§@ªí¸Ì,¦p #1 ¼Ðµù
Crr = Y(Z)
'¡ô¥ÎCrr ¸Ë³oY(Z)°}¦C¨Ó¬Ý¤ñ¸û²ßºD!¬Ý¨ì¬A©·()´N®`©È!
With Sheets.Add(after:=Sheets(Sheets.Count))
'¡ô¦b¤W¤è·s¶}ªº¬¡¶Ã¯³Ì«á¤u§@ªí«á±¦A·s¶}¨Ì¤u§@ªí
.Name = Replace(Z, "|", "")
'¡ô¤u§@ªí¦W¬O ¶µ¥Ø¦WºÙ&"|"¦r¦ê ¥h±¼ "|" ²Å¸¹
.[A1].Resize(UBound(Crr), UBound(Crr, 2)) = Crr
'¡ô§â°}¦C±q[A1]¶}©l¶K¶iÀx¦s®æ¸Ì¤F!
.[I:J].NumberFormatLocal = "yyyy/m/d"
'¡ô¥O[I:J]Ä檺®æ¦¡¬O ¦è¤¸4½X¦~ /¯à1½X´N¤£n¨â½Xªº¤ë/¤é
.Cells.Columns.AutoFit
'¡ô¥O¾ãªíªº©Ò¦³Äæ¦ì¦Û°Ê½Õ¾ãÄæ¼e
End With
End If
Next
End Sub
Àµ½Ð¦U¦ì«e½ú«ü¥¿¨Ã«ü¾É! |
|