返回列表 上一主題 發帖

[發問] 如何利用VBA一鍵 自動比對工作表A & B的C欄相異號碼？

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
1# 跳轉到 »
發表於 2015-11-14 15:44 | 顯示全部帖子
試試看:
1. 插入UserForm1, 並設定 Caption 的屬性為"比對結果"
2. 在 UserForm1 中插入 Label1, ListBox1 及 CommandButton1
3. 設定 UserForm1.CommandButton1 的 Caption 屬性為"確定"
4. Double Click UserForm1.CommandButton1, 在編輯視窗中鍵入下列 VBA code:
  1. Private Sub CommandButton1_Click()
  2.         Unload Me
  3.     End Sub
複製代碼
5. 離開VBA編輯視窗回到 sheetA, 在 sheetA 中插入CommandButton1,
    並設定 Caption 的屬性為"按我比對"
6. Double Click CommandButton1, 在編輯視窗中鍵入下列 VBA code:
  1. Private Sub CommandButton1_Click()
  2.     Dim rngA As Range, rngB As Range, rngC As Range
  3.     Dim cel As Range, foundCel As Range
  4.     Dim cntLB As Integer, R As Integer
  5.     Set rngA = [A!C3:C79]
  6.     Set rngB = [B!C3:C1000]
  7.     Set rngC = [C!C3:C500]
  8.     '
  9.     '先比對rngB 及rngC, 並將相異號碼存到暫存區[B!D:D]
  10.     '再重設 rngB, 進而比對rngB 及rngA
  11.     '
  12.     UserForm1.ListBox1.Clear       '清除ListBox
  13.     [B!D:D] = ""     '清除暫存區
  14.     R = 1
  15.     For Each cel In rngC
  16.         If cel <> "" Then
  17.             Set foundCel = rngB.Find(cel, LookAt:=xlWhole, SearchDirection:=2)
  18.             
  19.             'foundCel Is Nothing 表示沒找到, 即 rngC的cel 與 rngB 不重覆
  20.             If foundCel Is Nothing Then
  21.                 R = R + 1
  22.                 Sheets("B").Cells(R, 4) = cel '將 rngC的cel 加到 暫存區
  23.             End If
  24.         End If
  25.     Next
  26.    
  27.     Set rngB = [B!C3:D1000]      '再重設 rngB
  28.     For Each cel In rngB
  29.         If cel <> "" Then
  30.             Set foundCel = rngA.Find(cel, LookAt:=xlWhole, SearchDirection:=2)
  31.             
  32.             'foundCel Is Nothing 表示沒找到, 即 rngB的cel 與 rngA 不重覆
  33.             If foundCel Is Nothing Then
  34.                 UserForm1.ListBox1.AddItem cel    '將 rngB的cel 加到 ListBox1
  35.             End If
  36.         End If
  37.     Next
  38.     cntLB = UserForm1.ListBox1.ListCount
  39.     If cntLB = 0 Then
  40.         MsgBox "找不到相異號碼!!", vbCritical
  41.     Else
  42.         UserForm1.Label1.Caption = "共有" & cntLB & "筆相異號碼," & Chr(10) _
  43.                  & "如下所列："
  44.         UserForm1.Show
  45.     End If
  46. End Sub
複製代碼
test.gif

TOP

        靜思自在 : 【時間無法遮擋】怕時間消逝，花了許多心血，想盡各式方法要遮擋時間，結果是：浪費了更多時間，且一無所成！
返回列表 上一主題