- ©«¤l
- 835
- ¥DÃD
- 6
- ºëµØ
- 0
- ¿n¤À
- 915
- ÂI¦W
- 14
- §@·~¨t²Î
- Win 10,7
- ³nÅ骩¥»
- 2019,2013,2003
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2010-5-3
- ³Ì«áµn¿ý
- 2024-11-6
|
§ÚªºÀɮצ³¨â±isheet ¡u¶i³f¡v¡B¡u¾ú¥v¶i³f¡v
¨C¤Ñ¡u¶i³f¡vsheet³£·|¤£¤@¼Ë¡A¦Ó¡u¾ú¥v¶i³f¡v´N¬O§â¨C¤Ñ¡u ...
zero1019 µoªí©ó 2014-9-19 00:27 - Private Sub cbTran_Click()
- Dim lSRow&, lTRow&
- Dim vD
- Dim wsSou As Worksheet
-
- Set vD = CreateObject("Scripting.Dictionary")
- lSRow = 2
- Set wsSou = Sheets("¾ú¥v¶i³f")
- With wsSou
- Do While .Cells(lSRow, 1) <> ""
- With .Cells(lSRow, 1)
- vD(.Value) = .Offset(, 2)
- End With
- lSRow = lSRow + 1
- Loop
- End With
-
- lTRow = 2
- With Sheets("¶i³f")
- Do While .Cells(lTRow, 1) <> ""
- With .Cells(lTRow, 1)
- If Not vD.Exists(.Value) Then
- vD(.Value) = .Offset(, 1)
- wsSou.Cells(lSRow, 1) = .Value
- wsSou.Cells(lSRow, 2) = .Offset(, 1)
- lSRow = lSRow + 1
- End If
- .Resize(1, 2).Delete xlShiftUp
- End With
- Loop
- MsgBox "¾ú¥v¶i³f¸ê®Æ¤w§ó·s§¹²¦..."
- .Cells(2, 1).Select
- End With
- End Sub
½Æ»s¥N½X
¨C¤é¶i³f»P¾ú¥v®w¦s¸ê®Æ-a.zip (17.61 KB)
|
|