- ©«¤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 ©ó 2022-10-26 13:29 ½s¿è
«á¾Ç¾Ç²ß¤ß±o¦p¤U!
½Ð¦U¦ì«e½ú«ü¥¿¨Ã«ü¾É!ÁÂÁÂ
Option Explicit
Sub TEST()
Dim Brr, i&, T(5), TT, V&, Y, Z
Dim A, B
'¡ô«Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY¬°¦r¨å
Set A = Sheets(1)
'¡ô¥OA¬O²Ä¤@Ó¤u§@ªí
Set B = Sheets(2)
'¡ô¥OA¬O²Ä¤GÓ¤u§@ªí
Brr = A.[A1].CurrentRegion
'¡ô¥OBrr¬O°}¦C,ˤJªí¤@[A1]³s±µ¨ìªºÀx¦s®æ
',ÂX®i¦Ü³Ì¤p¤è¥¿°Ï°ìÀx¦sÓªºÈ
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é±N²Å¦X±ø¥óªº¦CˤJY¦r¨å¸Ì
T(1) = Brr(i, 1)
T(2) = Brr(i, 2)
T(3) = Brr(i, 3)
T(4) = Brr(i, 4)
T(5) = Brr(i, 5)
TT = T(1) & "|" & T(2)
If T(4) <> "" Then
If Y.Exists(TT) Then
'¡ô¦pªG§PÂ_Y¦r¨å¸Ì¦³¸ê®Æ?
MsgBox i & " ¦C¼tµP+³W®æ ¦³«½Æ!¤£¤¹³\°õ¦æ"
'¡ô¦]¬°«á¾Ç³]©wªº±¡¹Ò ¼tµP+³W®æ ¤£«½Æ,´N¸Ó¦³Àˬd¾÷¨î
'§_«h¼Æ¶q·|¥u§ì³Ì«á¤@µ§,¦Ó¦XpÈ«o¤w²Ö¥[ª÷ÃB
GoTo 333
'¡ô¸õ¨ì 333 ¦ì¸mÄ~Äò°õ¦æ!
End If
Y(TT) = Array(T(1), T(2), T(3), T(4), T(5))
If IsNumeric(T(5)) Then
'¡ô¦pªG§PÂ_²Ä5Ä檺¸ê®Æ¬O¼Æ¦r?
'¦]¬°[E1] ¬O "ª÷ÃB"¦r¦ê,©Ò¥HnÂo±¼«D¼Æ¦r!
V = V + T(5)
'¡ôª÷ÃB²Ö¥[
End If
End If
Next
TT = "Á`p"
'¡ô¥OTT¬O "Á`p" ¦r¦ê
Y(TT) = Array(TT, "", "", "", V)
'¡ô§â "Á`p" ·íkey,¤@ºû°}¦C·íitem
'¡ô¦³¤@ÂI«Ü«n! Y(TT) = Array(TT, , , , V) ¨S¦³¿ìªk°õ¦æ!
B.UsedRange.EntireRow.Delete
'¡ô§R°£ªí¤G ¦³¨Ï¥Îªº¦C
B.[A1].Resize(Y.Count, 5) = Application.Transpose(Application.Transpose(Y.items))
'¡ô§âY¦r¨åªºItemÂà¸m¶K¤J ±qªí¤Gªº[A1] ¶}©l
B.Range(B.Cells(Y.Count, 1), B.Cells(Y.Count, 5)).Interior.ColorIndex = 6
'¡ôªí¤GªºÁ`p¨º5®æ©³¦â§ï¬° ¶À¦â6
333
Set Y = Nothing
Set Brr = Nothing
End Sub |
|