[發問] excel VBA 從大量資料中裡找出共同重複的資料

Duck

我想要從1.2.3 找出他們三個相同的資料出來，如圖所示三個共同相同的地方是B C D，
請問我要怎樣寫VBA的語法?  
圖上的例子我只用1.2.3這三個而已，實際上是有n筆資料的，所以寫請問大大們，要如何從n筆資料找出共同的地方出來?

yen956

花了不少時間, 總算對 Ditionary 有一點點了解,
d(a.Value) = ""  與
If Not exists(a.Value) Then d.Add a.Value, "" 同義.
下列修改自 15# GBKEE版大的VBA(版大的執行結果完全正確),
請指教!!

1. '修改自 15# GBKEE版大的VBA
   
2. Sub Test()
   
3.     Dim d As Object, d2 As Object, AR(1 To 3), ArC()
   
4.     Dim M As Variant, E As Variant
   
5.     Dim LstA As Integer, LstB As Integer, Cnt As Integer, Cnt2 As Integer
   
6.     Dim i As Integer, J As Integer
   
7.     Set d = CreateObject("SCRIPTING.DICTIONARY")
   
8.     Set d2 = CreateObject("SCRIPTING.DICTIONARY")
   
9.     Range("C:G").ClearContents    '清除工作表4 C欄-->G欄
   
10.     Range("E:E").Interior.ColorIndex = xlNone
    
11.     LstB = [B65536].End(xlUp).Row
    
12.     Cnt = 1
    
13.     Cnt2 = 1
    
14.     ArC = Array(35, 36, 37, 38)
    
15.    
    
16.     '以下計算 工作表1-> 工作表3 出現機率為80%的字母*****
    
17.     For i = 1 To 3   '從 "工作表1" 到 "工作表3"
    
18.         Sheets(i).Range("C:E").ClearContents    '清除每一頁的 C欄-->E欄
    
19.         With Sheets(i).[C1].Resize(Sheets(i).[B65536].End(xlUp).Row)   '即[C1:Cxx]
    
20.             .Cells = "=COUNTIF(C2,RC[-1])/COUNTA(C1)"
    
21.             '[C1]公式 = COUNTIF(B:B,B1)/COUNTA(A:A), 即計算每個字母出現的機率
    
22.             
    
23.             AR(i) = Application.Transpose(.Offset(, -1).Resize(, 2).Value)
    
24.             '將 B欄,C欄 轉置為 AR(1 to 2, 1 to 21)
    
25.             
    
26.             '將英文字母出現百分比機率導入 AR(i)
    
27.             For Each E In .Cells    '歷遍每一頁的 [C1:Cxx]
    
28.                 d2.Item(E.Offset(, -1).Value) = E.Value
    
29.                 '將字母(Key)及機率(Item)全部存入 字典d2 中(不論機率大小)
    
30.                
    
31.                 If E >= 0.8 Then d(E.Offset(, -1).Value) = E.Value
    
32.                 '將機率 >=80% 的字母及機率, 放到 字典d 中
    
33.             Next
    
34.             
    
35.             .Cells = .Value             '公式轉為值
    
36.             
    
37.             If d.Count >= 1 Then
    
38.                 .Cells(1).Range("B1").Resize(d.Count) = Application.Transpose(d.keys)   '傾倒字母到每頁的 [D1:Dxx]
    
39.                 .Cells(1).Range("C1").Resize(d.Count) = Application.Transpose(d.Items)  '傾倒機率到每頁的 [E1:Exx]
    
40.                 '★這裡若將 .Range("B1") 改為 .[B1]
    
41.                 '  則會出現 "物件不支援屬性或方法" 的錯誤!!
    
42.             End If
    
43.             
    
44.             If d2.Count >= 1 Then
    
45.                 '固定式(工作表4的A欄及B欄的表格事先填好)
    
46.                 '***工作表4上 B欄位中，每個英文字母出現在指定工作表的比率***
    
47.                 M = Application.Match(Sheets(i).Name, [A:A])
    
48.                 If IsNumeric(M) Then
    
49.                     If i = 3 Then
    
50.                         LstA = LstB
    
51.                     Else
    
52.                         LstA = Cells(M, 1).End(xlDown).Row - 1
    
53.                     End If
    
54.                     For J = M To LstA
    
55.                         If d2.Exists(Cells(J, 2).Value) Then
    
56.                             Cells(J, 3) = d2(Cells(J, 2).Value)
    
57.                         End If
    
58.                     Next
    
59.                     Cnt = LstA + 1
    
60.                 End If
    
61.             
    
62.                 '機動式(E欄(工作表名稱)及F欄(字母)的表格由VBA填入)
    
63.                 '***工作表4上 F欄位中，每個英文字母出現在指定工作表的比率***
    
64.                 Cells(Cnt2, 5) = Sheets(i).Name    '工作表名稱
    
65.                 Cells(1).Range("E" & Cnt2).Resize(d2.Count).Interior.ColorIndex = ArC(i)
    
66.                 Cells(1).Range("F" & Cnt2).Resize(d2.Count) = Application.Transpose(d2.keys)   '傾倒字母
    
67.                 Cells(1).Range("G" & Cnt2).Resize(d2.Count) = Application.Transpose(d2.Items)  '傾倒機率
    
68.                 Cnt2 = d2.Count + 1
    
69.             End If
    
70.         End With
    
71.         d.RemoveAll
    
72.         d2.RemoveAll
    
73.         Sheets(i).Range("C:C", "E:E").NumberFormatLocal = "0%"  '數字格式化
    
74.     Next
    
75.     Range("C:C", "G:G").NumberFormatLocal = "0%"  '數字格式化
    
76. End Sub

複製代碼

yen956

感謝c_c_lai, GBKEE, 准提部林 等大大的說明,
因為一般文件只提到 d.Add "a", "Athens" 的方法,
現在總算知道 d(a.Value) = "" 這個方法的真正函義,
d(a.Value) = ""　＿＿key 為 a.value　，　item 為 空字符
謝謝大大們詳細的說明, 謝謝!!

准提部林

回復 12# yen956


d(a.Value) = ""　＿＿key 為 a.value　，　item 為 空字符

key者，可稱其為〔索引值〕，具〔唯一不重覆〕性，
若只想取出不重覆項目，item 就不須處理，所以給個任意資料，一般給空字符即可！

要注意：１．文字格式與數值格式的純數字，或英文的大．小寫，放在 key 中是視為不同的！
　　　　２．key 的來源若為〔儲存格參照〕，必須使用 rng.value 或 rng.text 或 rng & "" 方式，
　　　　　　這時就涉及〔數值〕與〔文字〕格式的問題，依需求去決定其格式！
　　　　　　例如：Ａ１為〔日期〕2016/01/01，自訂格式為〔YYYY/MM/DD]，亦即其值為〔數值〕42370，只是格式看起來為日期，
　　　　　　　　　那麼，[A1].Value　為 2016/1/1 等同 42370
　　　　　　　　　　　　[A1].Text　　則為〔文字〕2016/01/01
　　　　　　　　　　　　[A1] & ""　　又為〔文字〕2016/1/1

Sub 測試()
Set xD = CreateObject("Scripting.Dictionary")
xD([A1].Value) = ""
xD([A1].Text) = ""
xD([A1] & "") = ""
xD(42370) = ""
MsgBox xD.Count　'只有３而非４個，因第１及第４〔值〕相同
End Sub


＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
至放 item 因各種需求，可做很多的變化，一時說不清，可多找找更多實際範例看看～～
　

GBKEE

回復 12# yen956
vba的說明

1. Dictionary 物件
   
2. 物件，用於儲存資料關鍵字和項目對。
   
3. 語法
   
4. Scripting.Dictionary
   
5. 請注意
   
6. Dictionary 物件與 PERL 相關陣列全等。可以是任何型式的資料的項目被儲存在陣列中。每個項目都與一個唯一的關鍵字相關。該關鍵字用來取出單個項目，通常是整數或字串，可以是除陣列外的任何型態。
   
7. 下面的程式碼舉例說明了如何建立一個 Dictionary 物件：
   
8. 
   
9. Dim d                   '建立一個變數
   
10. Set d = CreateObject(Scripting.Dictionary)
    
11. d.Add "a", "Athens"     '加入一些關鍵字和項目
    
12. d.Add "b", "Belgrade"
    
13. d.Add "c", "Cairo"

複製代碼

9#附檔的程式碼試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim d As Object, E As Variant, AR(1 To 3), i As Integer
   
4.     Dim Rng As Range, AX(), M As Variant
   
5.     Set d = CreateObject("SCRIPTING.DICTIONARY")
   
6.     '工作表1-> 工作表3  '出現機率為80%的字母*****
   
7.     For i = 1 To 3   '"工作表1"->"工作表3" 在活頁簿上的 Index
   
8.          MsgBox Sheets(i).Name  '可註解掉
   
9.         With Sheets(i).Range("B:B").SpecialCells(xlCellTypeConstants).Offset(, 1)
   
10.             .Cells = "=COUNTIF(C2,RC[-1])/COUNTA(C1)"  '儲存格寫上公式
    
11.             AR(i) = Application.WorksheetFunction.Transpose(.Offset(, -1).Resize(, 2).Value)
    
12.             'AR(i) 導入英文字母出現百分比機率
    
13.             For Each E In .Cells
    
14.                 If E >= 0.8 Then d(E.Offset(, -1).Value) = ""
    
15.             Next
    
16.             .Cells = .Value             '公式轉為值
    
17.             .NumberFormatLocal = "0%"   '數字格式化
    
18.             .Cells.Offset(, 1) = ""
    
19.             If d.Count >= 1 Then
    
20.                 .Cells(1).Range("B1").Resize(d.Count) = Application.WorksheetFunction.Transpose(d.keys)
    
21.             End If
    
22.         End With
    
23.         d.RemoveAll
    
24.     Next
    
25.    
    
26.     '***工作表4 上B欄位中，每個英文字母出現在指定工作表的比率***
    
27.     Set Rng = Sheets("工作表4").Range("A1")
    
28.     i = 0
    
29.     Do Until Rng Is Nothing
    
30.         AX = AR(Sheets(Rng.Value).Index) '"工作表1"->"工作表3" 在活頁簿上的 Index
    
31.         'AR(Sheets(Rng.Value).Index) 導出各個工作表上英文字母的機率
    
32.         M = Application.Match(Rng.Offset(i, 1), Application.Index(AX, 1), 0)
    
33.         'Application.Match 工作表函數
    
34.         With Rng.Offset(i, 2) 'C欄
    
35.             If Not IsError(M) Then
    
36.                 .Cells = AX(2, M)
    
37.             Else
    
38.                 .Cells = 0
    
39.             End If
    
40.             .NumberFormatLocal = "0%"
    
41.         End With
    
42.         i = i + 1
    
43.         If Rng.Offset(i) <> "" Then  '下一個工作表
    
44.             Set Rng = Rng.Offset(i)
    
45.             i = 0
    
46.         ElseIf Rng.Offset(i, 1) = "" Then '沒有字串
    
47.             Set Rng = Nothing   '離開迴圈的條件
    
48.         End If
    
49.     Loop
    
50. End Sub

複製代碼

hcm19522

http://blog.xuite.net/hcm19522/twblog/369872449
函數 參考即可

c_c_lai

回復 12# yen956

下載 (30.59 KB)

2016-1-1 08:05

yen956

回復 4# Hsieh
超版你好!!
請問: If Application.CountIf(Rng, a) > 1 Then d(a.Value) = ""
中的 d(a.Value) = "" 是什麼意思?
猜想是將 a 的 Key 丟到字典中, 或是將 a 的 Item 丟到字典中,
但為什麼是 d(a.Value) = "" 呢? 作用是什麼?
謝謝!!

Hsieh

回復 10# Duck


    計算各自母的出現率不難，但實在不解前3個工作表的字母要求出現率在80%以上
幾乎不可能啊!
假設有，那就是要顯示到工作表4的B欄嗎?
那跟A欄的資料又有甚麼關聯?
上傳的範例最好是能顯示想要的結果，否則很難看出你的需求

Duck

回復 8# Hsieh


    想請問一下，不知您是否了解我的問題了嗎?  這有辦法用vba執行嗎?