- ©«¤l
- 1447
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1471
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2025-3-24
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2024-3-1 10:17 ½s¿è
ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,±N¤Gºûµ²ªG°}¦C¦b¦r¨å´£¨ú/½s¿è/©ñ¦^...¹F¨ì·Qnªº®ÄªG,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
°õ¦æ«e:
°õ¦æµ²ªG:
Option Explicit
Sub TEST()
Dim Brr, Crr(1 To 200, 1 To 2), A, Z, i&, j%, R&, c%, T$, xR As Range
'¡ô«Å§iÅܼÆ:&¬Oªø¾ã¼Æ,%¬Oµu¾ã¼Æ,¨S¦³«ü©w¬O³q¥Î«¬ÅܼÆ
Set Z = CreateObject("Scripting.Dictionary")
'¡ô¥OZÅܼƬO ¦r¨å
Brr = Range([IV1].End(xlToLeft), [A65536].End(xlUp))
'¡ô¥OBrrÅܼƬO ±a¤J°Ï°ìÀx¦s®æȪº¤Gºû°}¦C
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é!¥Oi±q2 ¨ìBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
T = Trim(Brr(i, 1)): A = Z(T): R = Z(T & "/r")
'¡ô¥OTÅܼƬOi°j°é¦C1ÄæBrr°}¦CÈ:¥OAÅܼƬO ¥HÅܼƬdZ¦r¨å¦^¶ÇªºitemÈ
'¥ORÅܼƬO TÅܼƳs±µ"/r"¦r¦ê²Õ¦¨ªº·s¦r¦ê¬°key,¬dZ¦r¨å¦^¶ÇªºitemÈ
If Not IsArray(A) Then A = Crr: R = 1: A(R, 1) = Brr(1, 1): A(R, 2) = Brr(i, 1)
'¡ô¦pªGAÅܼƤ£¬O¤Gºû°}¦C!´N¥OAÅܼÆÅܬ°¦PCrrªº¤Gºû°}¦C:¥ORÅܼÆ=1:¥ORÅܼƦC1ÄæA°}¦CȬO 1¦C1ÄæBrr°}¦CÈ
'¥ORÅܼƦC2ÄæA°}¦CȬO i°j°é¦C1ÄæBrr°}¦CÈ
For j = 2 To UBound(Brr, 2)
'¡ô³]¶¶°j°é!¥Oj±q2 ¨ìBrr°}¦C¾î¦V³Ì¤j¯Á¤ÞÄ渹
If Brr(i, j) = "" Then GoTo j01
'¡ô¦pªGi°j°é¦Cj°j°éÄæBrr°}¦CȬO ªÅ¦r¤¸!´N¸õ¨ì¼Ð¥Üj01¦ì¸mÄ~Äò°õ¦æ
R = R + 1
'¡ô¥ORÅܼƲ֥[1
A(R, 1) = Brr(1, j)
'¡ô¥ORÅܼƦC1ÄæA°}¦CȬO 1¦Cj°j°éÄæBrr°}¦CÈ
A(R, 2) = Brr(i, j)
'¡ô¥ORÅܼƦC2ÄæA°}¦CȬO i°j°é¦Cj°j°éÄæBrr°}¦CÈ
j01: Next
Z(T) = A: Z(T & "/r") = R
'¡ô¥Okey¬O TÅܼÆ,ªºitemÈ¥H AÅܼƩñ¦^Z¦r¨å¤¤
Next
Set xR = [A11]
'¡ô¥OxRÅܼƬO ª«¥ó A11 Àx¦s®æ
For Each A In Z.KEYS
'¡ô³]³v¶µ°j°é!¥OAÅܼƬO Z¦r¨å¸Ìªºkey
If Not IsArray(Z(A)) Then GoTo A01
'¡ô¦pªG¥HAÅܼƬdZ¦r¨å±oitem¤£¬O°}¦C!´N¸õ¨ì¼Ð¥Ü A01¦ì¸mÄ~Äò°õ¦æ
xR.Resize(Z(A & "/r"), 2) = Z(A)
'¡ô¥O°Ï°ìÀx¦s®æ¥H ¤Gºû°}¦Cȼg¤J
Set xR = xR(1, 4)
'¡ô¥OxRÅܼÆÅܬ°¦V¥k²¾°Ê¦Û¨®æºâ°_ªº²Ä4ÄæÀx¦s®æ
A01: Next
End Sub |
|