- ©«¤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-11-28
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-12-4 08:54 ½s¿è
ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
°õ¦æ«e:
°õ¦æµ²ªG:
Option Explicit
Sub TEST()
Dim Brr, Crr, i&, j%, R&, T$
'¡ô«Å§iÅܼÆ
Brr = Intersect(ActiveSheet.UsedRange, [A:K])
'¡ô¥OBrrÅܼƬO ¸Ë²±«ü©wÀx¦s®æȪº¤Gºû°}¦C
ReDim Crr(1 To 1000, 1 To 4)
'¡ô«Å§iCrrÅܼƬO¤Gºû ªÅ°}¦C
For i = 3 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 Val(Brr(i, 10)) = 0 Then GoTo i01 Else R = R + 1: Crr(R, 1) = T
'¡ô¦pªGi°j°é¦C²Ä10ÄæBrr°}¦CÈÂ༪º¼ÆȬO0?? ´N¸õ¨ì¼Ð¥Ü i01¦ì¸mÄ~Äò°õ¦æ,
'§_«h´N¥ORÅܼƲ֥[1,¥ORÅܼƦC²Ä1ÄæCrr°}¦CȬO TÅܼÆ
For j = 3 To 9
'¡ô³]¶¶°j°é!j±q3¨ì9
If Trim(Brr(i, j)) <> "" Then
'¡ô¦pªG³vÄæ§P©w¨äȤ£¬OªÅÈ
Crr(R, 2) = Brr(2, j)
'¡ô¥O²Ä2ÄæCrr°}¦CÈ¥HBrr°}¦C²Ä2¦C²Äj°j°éÄæȱa¤J
Crr(R, 3) = Brr(i, j)
'¡ô¥O²Ä3ÄæCrr°}¦CÈ¥HBrr°}¦C²Äi°j°é¦C²Äj°j°éÄæȱa¤J
Crr(R, 4) = Brr(i, 10)
'¡ô¥O²Ä4ÄæCrr°}¦CÈ¥HBrr°}¦C²Äi°j°é¦C²Ä10Äæȱa¤J
Exit For
'¡ô¥O¸õ¥XjÅܼƪº°j°é
End If
Next
i01: Next
[R:U].ClearContents
'¡ô¥Oµ²ªGÄ椺®e²M°£
If R = 0 Then Exit Sub
'¡ô¦pªGRÅܼƬO 0(¥Nªí¨S¦³²Å¦Xªº¸ê®Æ),´Nµ²§ôµ{¦¡°õ¦æ
[R3].Resize(R, 4) = Crr
'¡ô¥O«ü©wÀx¦s®æÂX®iè¦nªº½d³òÀx¦s®æÈ¥HCrr°}¦Cȱa¤J
End Sub |
|