| ©«¤l835 ¥DÃD6 ºëµØ0 ¿n¤À915 ÂI¦W1  §@·~¨t²ÎWin 10,7 ³nÅ骩¥»2019,2013,2003 ¾\ŪÅv50 ©Ê§O¨k µù¥U®É¶¡2010-5-3 ³Ì«áµn¿ý2025-7-5 
 | 
                
| §ÚªºÀɮצ³¨â±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
 ½Æ»s¥N½XPrivate 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
 ¨C¤é¶i³f»P¾ú¥v®w¦s¸ê®Æ-a.zip (17.61 KB) | 
 |