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