| ©«¤l1517 ¥DÃD40 ºëµØ0 ¿n¤À1541 ÂI¦W0  §@·~¨t²ÎWindows  7 ³nÅ骩¥»Excel 2010 & 2016 ¾\ŪÅv100 ©Ê§O¨k ¨Ó¦Û¥xÆW µù¥U®É¶¡2020-7-15 ³Ì«áµn¿ý2025-10-31 
 | 
                
| ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú «á¾ÇÂǦ¹©«½m²ß°}¦C,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
 °õ¦æ«e:
 
     
 °õ¦æµ²ªG:
 
     
 
 Option Explicit
 Sub TEST()
 Dim Brr, Crr, i&, j%, R&, T$
 '¡ô«Å§iÅܼÆ
 Brr = Intersect(Range([A1], ActiveSheet.UsedRange), [A:G])
 '¡ô¥OBrrÅܼƬO ¸Ë²±«ü©wÀx¦s®æÈªº¤Gºû°}¦C
 ReDim Crr(1 To 1000, 1 To 4)
 '¡ô«Å§iCrrÅܼƬO¤Gºû ªÅ°}¦C
 For i = 4 To UBound(Brr)
 '¡ô³]¶¶°j°é!i±q3¨ìBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
 If T <> Trim(Brr(i, 1)) And Trim(Brr(i, 1)) <> "" Then T = Trim(Brr(i, 1))
 '¡ô¦pªGTÅܼƻP i°j°é¦C²Ä1ÄæBrr°}¦CÈ(¥B¤£¬OªÅÈ)¤£¦P??´N¥OT¬O¸ÓÈ
 If Trim(Brr(i, 3)) = "" Then GoTo i01
 '¡ô¦pªG©m¦WÄæ¬OªÅªº? True´N¸õ¨ì¼Ð¥Ü i01¦ì¸mÄ~Äò°õ¦æ
 For j = 4 To 7
 '¡ô³]¶¶°j°é!j±q4¨ì7
 If InStr("/¤¤/±d/", "/" & Trim(Brr(i, j)) & "/") Then GoTo i01
 '¡ô¦pªG °ÊºAÄæ®æ¸Ì¬O"¤¤"©Î"±d"? True´N¸õ¨ì¼Ð¥Ü i01¦ì¸mÄ~Äò°õ¦æ
 Next
 R = R + 1
 '¡ô¥ORÅܼƲ֥[ 1
 Crr(R, 1) = Brr(2, 1)
 '¡ô¥ORÅܼƦC²Ä1ÄæCrr°}¦CȬO ¼Ó¼h
 Crr(R, 2) = T
 '¡ô¥ORÅܼƦC²Ä2ÄæCrr°}¦CȬO ©Ð¸¹
 Crr(R, 3) = Brr(i, 2)
 '¡ô¥ORÅܼƦC²Ä3ÄæCrr°}¦CȬO §Ç¸¹
 Crr(R, 4) = Brr(i, 3)
 '¡ô¥ORÅܼƦC²Ä4ÄæCrr°}¦CȬO ©m¦W
 i01: Next
 [L:O].ClearContents
 '¡ô¥Oµ²ªGÄæ²M°£¤º®e
 If R = 0 Then Exit Sub
 '¡ô¦pªGRÅܼƬO 0(¥Nªí¨S¦³²Å¦Xªº¸ê®Æ),´Nµ²§ôµ{¦¡°õ¦æ
 [L4].Resize(R, 4) = Crr
 '¡ô¥O«ü©wÀx¦s®æÂX®iè¦nªº½d³òÀx¦s®æÈ¥HCrr°}¦Cȱa¤J
 End Sub
 | 
 |