偉婕

由於所要處理的資料量太大
無法在Excel中以矩陣處理
所以,我現在想要去統計,若兩兩單字同時出現時,就計數為1(不重複計數),否則為0
不知要怎麼處理?
謝謝!

例如
Robots; Cutting Waterjet; Automotive Industry
Robots; Control; Manipulators
Robots; Control; Aerospace;
Robots; Control; Actuators;
Robots; Control;

則
Robots 為 6
Cutting Waterjet 為 2
Automotive Industry 為 2
Control 為 4
Manipulators 為 2
Aerospace 為 2
Actuators 為2

偉婕

回復 12# Hsieh
謝謝[Hsieh]版主的回覆,不過可能我表達的不好,會錯意了
我的意思是,我是想求兩兩單字同時出現時,就計數1,但若已經出現過了,就不再計數一次
也就是說,有Robots; Control; Manipulators 三個單字
則有以下組合 Robots與Control 、 Control與Manipulators 、Robots與Manipulators
故 Robots　為 2  、　Control　為 2 、　Manipulators　為 2

例如
Robots; Cutting Waterjet; Automotive Industry
Robots; Control; Manipulators
Robots; Control; Aerospace;
Robots; Control; Actuators;
Robots; Control;

則
Robots 為 6 (因為　Robots與Cutting Waterjet、Robots與Automotive Industry、Robots與Control、Robots與Manipulators、Robots與Aerospace、Robots與Actuators),雖然有出現4次Robots與Control，但皆只算1次
Cutting Waterjet 為 2 (因為 Robots與Cutting Waterjet、Automotive Industry與Cutting Waterjet)
Automotive Industry 為 2 (因為 Robots與Automotive Industry、Automotive Industry與Cutting Waterjet)
Control 為 4 (因為 Control 與Robots、Control 與Manipulators、Control 與Aerospace、Control 與Actuators)

再請教各位,謝謝!

Hsieh

回復 12# 偉婕
測試看看

1. Sub Ex()
   
2. Dim Ay()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. Set d2 = CreateObject("Scripting.Dictionary")
   
6. d2("單字") = "數量"
   
7. With Sheet1
   
8. For Each a In Range(.[B2], .[B65536].End(xlUp))
   
9. ar = Split(a, ";")
   
10. ReDim Preserve Ay(s)
    
11. Ay(s) = ar
    
12. s = s + 1
    
13. For Each b In ar
    
14.   If b <> "" Then d(Trim(b)) = ""
    
15. Next
    
16. Next
    
17. For Each ky In d.keys
    
18.    For i = 0 To UBound(Ay)
    
19.       If IsNumeric(Application.Match(ky, Ay(i), 0)) Then
    
20.          For Each c In Ay(i)
    
21.            If c <> ky Then d1(c) = ""
    
22.          Next
    
23.       End If
    
24.    Next
    
25.    d2(ky) = d1.Count: d1.RemoveAll
    
26. Next
    
27. .[F1].Resize(d2.Count, 1) = Application.Transpose(d2.keys)
    
28. .[G1].Resize(d2.Count, 1) = Application.Transpose(d2.items)
    
29. End With
    
30. 
    
31. End Sub

複製代碼

偉婕

回復 13# Hsieh

謝謝[Hsieh]版主
不過我測試的結果怪怪怪,僅有5個單字有出現數量，其它都顯示0
而有數量的，我看了一下是對的
不知出現0的是什麼原因？
謝謝！
Service Robots        2
Welding        3
Manipulators        2
Robot        4
Robots        43

Hsieh

回復 14# 偉婕
差在分號;多了空白鍵

1. Sub Ex()
   
2. Dim Ay()
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. Set d2 = CreateObject("Scripting.Dictionary")
   
6. d2("單字") = "數量"
   
7. With Sheet1
   
8. For Each a In Range(.[B2], .[B65536].End(xlUp))
   
9. ar = Split(Replace(a, "; ", ";"), ";")
   
10. ReDim Preserve Ay(s)
    
11. Ay(s) = ar
    
12. s = s + 1
    
13. For Each b In ar
    
14.   If b <> "" Then d(b) = ""
    
15. Next
    
16. Next
    
17. For Each ky In d.keys
    
18.    For i = 0 To UBound(Ay)
    
19.       If IsNumeric(Application.Match(ky, Ay(i), 0)) Then
    
20.          For Each c In Ay(i)
    
21.            If c <> ky Then d1(c) = ""
    
22.          Next
    
23.       End If
    
24.    Next
    
25.    d2(ky) = d1.Count: d1.RemoveAll
    
26. Next
    
27. .[F1].Resize(d2.Count, 1) = Application.Transpose(d2.keys)
    
28. .[G1].Resize(d2.Count, 1) = Application.Transpose(d2.items)
    
29. End With
    
30. End Sub

複製代碼

偉婕

回復 15# Hsieh

一直納悶,為何有些正常,有些卻顯示0值
剛剛比對成功的與顯示0值的資料
發現若把分號後面多餘的空白刪除就正常了
才剛要上來回報找到原因了
沒想到[Hsieh]版主先一步找到原因
再次感謝!