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

RCRG

一鍵自動比對兩工作表相異號碼.rar (12.97 KB)

下載次數: 22

2015-11-12 11:31

下載 (22.07 KB)

2015-11-12 11:35

下載 (11.1 KB)

2015-11-12 11:34

lpk187

回復 1# RCRG
Msgbox的最大字元多少，不知道，不過依VBE說明:最大長度大約是1024個字元，由使用字元的寬度決定。如果 prompt 超過一行，您可以在每一行之間用復位字元(Chr(13))、換行字元 (Chr(10)) 或是復位字元與換行字元的組合 (Chr(13) & Chr(10)) 來做區隔。
是不是換行後可以增加，不確定。請自行參考VBE說明

1. Sub 按鈕1_Click()
   
2. Dim Rng As Range
   
3. With Sheets("B")
   
4.     For Each Rng In .Range("C2:CC1000")
   
5.         If Rng <> "" Then
   
6.             Set da = Sheets("A").Range("c3:c79").Find(Rng.Value, LookAt:=xlWhole, SearchDirection:=2)
   
7.             If da Is Nothing Then
   
8.                 aa = aa & Rng.Value & ","
   
9.             Else
   
10.                 Set da = Nothing
    
11.             End If
    
12.         End If
    
13.     Next
    
14.     aa = Left(aa, Len(aa) - 1)
    
15.     MsgBox aa
    
16. End With
    
17. End Sub

複製代碼

RCRG

回復 2# lpk187


    　謝謝lpk187大的解答，完全符合我所要的(C2:C1000範圍錯了，我自行修正了)；
對了，Msgbox我如果前面要在加些中文 "相異號碼如下：L777779,L787878C,L989598"，這樣要如何修改呢?

lpk187

回復 3# RCRG


    MsgBox "相異號碼如下：" & aa

RCRG

回復 2# lpk187


    發現一個異常，就是如果工作表B的C欄位沒資料可以比對的話，會彈出一個錯誤視窗呢，能把空白內容視為正常嗎?

准提部林

Sub TEST()
Dim MH, ST, TT$
For Each ST In [B!C2:C1000]
　　MH = 0
　　If ST <> "" Then MH = Application.Match(ST, [A!C2:C79], 0)
　　If IsError(MH) Then TT = TT & "," & ST
Next
If TT <> "" Then MsgBox "相異號碼如下：" & Mid(TT, 2)
End Sub

RCRG

回復 6# 准提部林

1. 如果我要再多比對一個工作表C(但範圍只有到C2:C500)，我自行隨便亂修改如下應該沒問題吧(我自己測試起來是OK啦QQ)
2. 另外相異的號碼如果是一樣的可以只顯示一個嗎?如果有兩個L123456，彈出視窗就會跑L123456,L123456這樣，而我只想跑一個出來就好。
3. 如果比對的工作表B沒有內容或沒有相異號碼，按下去雖然不會有偵錯視窗了，但似乎也沒有任何視窗出現提醒，會讓人誤以為有在比對嗎?不知能否幫我彈出 "資料正常" 的彈出視窗字眼。


    Sub TEST()
Dim MH, ST, TT$
For Each ST In [B!C2:C1000]
　　MH = 0
　　If ST <> "" Then MH = Application.Match(ST, [A!C2:C79], 0)
　　If IsError(MH) Then TT = TT & "," & ST
Next

For Each ST In [C!C2:C500]
　　MH = 0
　　If ST <> "" Then MH = Application.Match(ST, [A!C2:C79], 0)
　　If IsError(MH) Then TT = TT & "," & ST
Next
If TT <> "" Then MsgBox "相異號碼如下：" & Mid(TT, 2)

End Sub

准提部林

回復 7# RCRG


For Each ST In [B!C2:C1000]
　　MH = 0
　　If ST <> "" Then MH = Application.Match(ST, [A!C2:C79], 0)
　　If IsError(MH) Then
　　　　If InStr("," & TT & ",", "," & ST & ",") = 0 Then TT = TT & "," & ST
　　End If
Next
If TT = "" Then MsgBox "無相異" Else MsgBox "相異號碼如下：" & Mid(TT, 2)

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
１．InStr("," & TT & ",", "," & ST & ",")
　　比對文字要以〔逗號〕前後包覆，否則以 L111222 比對 L111222A 會誤判！
　　以 ,L111222, 比對 ,L111222A, 就沒問題～這與使用 Find 函數同理～
　
２．If TT = "" Then MsgBox "無相異" Else MsgBox "相異號碼如下：" & Mid(TT, 2)
　　If ~~ Then ~~ Else ~~, 這是最簡單基本的判斷

若學 excel 已有一段時間， 上面的程式碼應都可以理解的！

yen956

試試看:
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

複製代碼

下載 (213.54 KB)

2015-11-14 15:44

RCRG

回復 8# 准提部林


    謝謝准大再次解題，讓見笑了...XD