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

[µo°Ý] «O¯d¨S¦³­«½ÆªºÄæ¦ì

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-12-1 18:56 ½s¿è

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
°õ¦æ«e:


°õ¦æµ²ªG:


Option Explicit
Sub TEST()
Dim Brr, Z, A, i&, j%, R&, Y&, T$
'¡ô«Å§iÅܼÆ
Set Z = CreateObject("Scripting.Dictionary")
'¡ô¥OZÅܼƬO¦r¨å
Brr = Range([C1], [A65536].End(3))
'¡ô¥OBrrÅܼƬO¸Ë¤JÀx¦s®æ­Èªº¤Gºû°}¦C
For i = 2 To UBound(Brr)
'¡ô³]¶¶°j°é!±q2¨ìBrr°}¦C³Ì¤j¯Á¤Þ¦C¸¹
   T = Brr(i, 1) & "|" & Brr(i, 3)
   '¡ô¥OTÅܼƬO²Ä1Äæ»P²Ä3Äæ°}¦C­È¥H "|"²Å¸¹¦ê±µªº·s¦r¦ê
   Z(T) = Z(T) + 1: Z(T & "/r") = i
   '¡ô¥OTÅܼƬ°keyªºitem­È²Ö¥[1(³o¬O­n°O¿ý¦r¦ê²Õ¥X²{¹L´X¦¸)
   '¡ô¥OTÅܼƳs±µ"/r" ªº·s¦r¦ê¬°key,item¬O¯Á¤Þ¦C¸¹,¯Ç¤JZ¦r¨å¤¤

Next
For Each A In Z.Keys
'¡ô³]³v¶µ°j°é!¥OA¬OZ¦r¨å¸ÌªºKeys¤§¤@
   If Right(A, 2) = "/r" Or Z(A) > 1 Then GoTo A01
   '¡ô¦pªG¬O°O¿ý¦C¸¹©Î ¦r¦ê²Õ¥X²{¹L¦¸¤j©ó1 ªº³£¸õ¹L
   R = R + 1: Y = Z(A & "/r")
   '¡ô¥ORÅܼƲ֥[1 (³o¬O­nÅý²Å¦X±ø¥óªº¸ê®Æ©ñ¸mªº¦C¸¹)
   For j = 1 To 3: Brr(R, j) = Brr(Y, j): Next
   '¡ô¥O²Å¦X±ø¥óªº¸ê®Æ¼g¤J«ü©wªº°}¦C¦ì¸m
A01: Next
If R = 0 Then Exit Sub Else [J:L].ClearContents
'¡ô¦pªG¨S¦³²Å¦X±ø¥óªº¸ê®Æ!´Nµ²§ôµ{¦¡°õ¦æ,§_«h²M°£Âªºµ²ªG®æ¤º®e
[J2].Resize(R, 3) = Brr
'¡ô¥OÂX®iªºÀx¦s®æ°Ï°ì¥HBrr°}¦C­È¼g¤J,¶W¹L¸Ó½d³òªº°}¦C­È©¿²¤
[J1:L1] = [A1:C1].Value
'¡ô¥O·s¼ÐÃD¦ì¸m®æ­Èµ¥©ó ­ì¼ÐÃD­È
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¤£©È¨Æ¦h¡A¥u©È¦h¨Æ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD