Board logo

標題: [發問] 請教關於同時出現次數之統計 [打印本頁]
作者: 偉婕    時間: 2010-6-28 22:26     標題: 請教關於同時出現次數之統計

本帖最後由 偉婕 於 2010-6-28 22:35 編輯

我有一堆資料,每筆資料中有數個單字,以分號區隔
我現在想要去統計,兩兩單字出現的次數,做成一個矩陣
例如:
NO        單字
1        Welding; Abb; Robots;
2        Robots; Cutting Waterjet; Automotive Industry;
3        Robots; Control;Manipulators
4        Robots; Control; Aerospace;
5        Robots; Control; Actuators;
6        Robots; Control;
則 Abb與Robots、Welding與Abb、Welding與Robots...等各1次;而Robots與Control有4次...(不管單字之順序)
不知要怎麼處理較佳,煩有經驗的網友可以提供參考,謝謝!
作者: Hsieh    時間: 2010-6-28 23:12

回復 1# 偉婕


    是這樣的意思嗎?[attach]1505[/attach]
作者: 偉婕    時間: 2010-6-29 00:11

回復 2# Hsieh

謝謝Hsieh版主
是我要的沒錯,不過請教一下,函數FIND($A2,x)中的x怎麼設定的,可否再說明,謝謝!
  1. SUMPRODUCT(ISNUMBER(FIND($A2,x))*ISNUMBER(FIND(B$1,x)))
複製代碼
作者: Hsieh    時間: 2010-6-29 06:04

回復 3# 偉婕


    x是動態範圍定義名稱
因為字串資料是不斷增加
定義公式
=OFFSET(單字!$B$2,,,COUNTA(單字!$B:$B)-1,)
以B2為基準點,向下擴充B欄資料數量的列數作為範圍
因為有標題列所以COUNTA(單字!$B:$B)-1
作者: 偉婕    時間: 2010-10-5 22:22

再請教各位,在完成矩陣後,若僅想保留一半
1)保留含對角線之右上角資料
2)保留不含對角線上右上角資料
有較快速的刪除方法嗎?
謝謝
作者: Hsieh    時間: 2010-10-6 00:07

  1. Sub 不含對角線()
  2. Dim Rng As Range
  3. r = [A65536].End(xlUp).Row
  4. For i = 2 To r
  5.     For j = i + 1 To r
  6.        If Rng Is Nothing Then
  7.        Set Rng = Cells(i, j)
  8.        Else
  9.        Set Rng = Union(Rng, Cells(i, j))
  10.        End If
  11.     Next
  12. Next
  13. Rng.Select
  14.      
  15. End Sub
  16. Sub 含對角線()
  17. Dim Rng As Range
  18. r = [A65536].End(xlUp).Row
  19. For i = 2 To r
  20.     For j = i To r
  21.        If Rng Is Nothing Then
  22.        Set Rng = Cells(i, j)
  23.        Else
  24.        Set Rng = Union(Rng, Cells(i, j))
  25.        End If
  26.     Next
  27. Next
  28. Rng.Select
  29.      
  30. End Sub
複製代碼
作者: 偉婕    時間: 2010-10-6 02:59

回復 6# Hsieh

謝謝［Hsieh］版主
作者: 偉婕    時間: 2010-10-8 20:34

再請教[Hsieh]版主
若只要選取"對角線"本身
要如何修改?
謝謝!
作者: Hsieh    時間: 2010-10-8 21:12

回復 8# 偉婕
  1. Sub 對角線()
  2. Dim Rng As Range
  3. r = [A65536].End(xlUp).Row
  4. For i = 2 To r
  5.        If Rng Is Nothing Then
  6.        Set Rng = Cells(i, i)
  7.        Else
  8.        Set Rng = Union(Rng, Cells(i, i))
  9.        End If
  10. Next
  11. Rng.Select
  12.      
  13. End Sub
複製代碼
作者: 偉婕    時間: 2010-10-9 04:46

回復 9# Hsieh

再次謝謝［Hsieh］版主
作者: 偉婕    時間: 2010-10-30 19:53

本帖最後由 偉婕 於 2010-10-30 22:33 編輯

由於所要處理的資料量太大
無法在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
作者: 偉婕    時間: 2010-10-30 22:32

回復 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    時間: 2010-10-30 23:51

回復 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

  31. End Sub
複製代碼
作者: 偉婕    時間: 2010-10-31 00:55

回復 13# Hsieh

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

回復 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
複製代碼
作者: 偉婕    時間: 2010-10-31 23:40

回復 15# Hsieh

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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)