GBKEE

回復 10# RCRG
試試看 VBA 還有其它語法可寫

1. Option Explicit
   
2. Sub EX()
   
3.     Dim Rng, AR, T, E
   
4.     Rng = Array([A!C3:C79], [B!C2:C79]) '[C!C2:C79],[D!C2:C79],[E!C2:C79].....可加入許多範圍
   
5.     For Each E In Rng
   
6.         AR = Application.Transpose(E.Value)
   
7.         T = T & "," & Join(AR, ",")
   
8.     Next
   
9.     AR = Split(T, ",")
   
10.     T = ""
    
11.     For Each E In AR
    
12.         If E <> "" Then
    
13.         'Filter 函數 傳回一個從零開始的陣列，該陣列包含基於指定篩選準則的一個字串陣列的子集。        '
    
14.            If UBound(Filter(AR, E, True)) = 0 Then '陣列裡只有一個元素
    
15.                 T = T & IIf(T <> "", ",", "") & E
    
16.            End If
    
17.         End If
    
18.     Next
    
19.     If T <> "" Then
    
20.         T = "相異號碼如下：" & vbLf & Replace(T, ",", vbLf)
    
21.     Else
    
22.         T = "查無相異號碼"
    
23.     End If
    
24.     MsgBox T
    
25. End Sub

複製代碼

准提部林

借用超板的〔陣中陣〕：
Sub TEST()
Dim xD, SS, S
Set xD = CreateObject("Scripting.Dictionary")
For Each SS In Array([B!C2:C1000], [C!C2:C1000])
For Each S In SS
　　If S <> "" And Not xD.Exists(S & "") Then xD(S & "") = ""
Next: Next
For Each S In [A!C3:C79]
　　If xD.Exists(S & "") Then xD.Remove S & ""
Next
If xD.Count Then MsgBox "相異號碼如下：" & Join(xD.keys, ",") Else MsgBox "無相異"
End Sub