[發問] 請問前輩關於VBA 中字串統計問題

ii31sakura

各位前輩請問一下~如小弟資料中"A"欄位字串資料顯示、小弟想將符合條件後進行統計即為 字串(條件項目"-"需統計出現最多次數目與項目)←進行比較與統計，
因"-"之後的項目是隨機出現、小弟之前有請教過前輩類似清單例出進行統計，
但此次為符合某條件後才進行統計，所以請教前輩們是否有其它方法像如此統計呢？


註：1. 比較data來源 → A欄位
         2.比較條件("G1")
         3.將結果列至("J1" & "J2")、

麻煩各位前輩幫忙了、感謝大家。
test統計.rar (15.02 KB)

下載次數: 13

2014-6-6 16:22

stillfish00

回復 1# ii31sakura

1. Sub Test()
   
2.   Dim r As Long, sCond As String
   
3.   Dim d, sSN As String, sType As String, max, maxType
   
4.   
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   
   
7.   With Sheets("Data")
   
8.     sCond = .[G1].Text
   
9.     r = .Cells(.Rows.count, "A").End(xlUp).Row - 1
   
10.     If r <= 0 Then Exit Sub
    
11.     For Each s In .[A2].Resize(r).Value
    
12.       sSN = Split(s, "-")(0)
    
13.       sType = Split(s, "-")(1)
    
14.       If sSN = sCond Then
    
15.         d(s) = d(s) + 1
    
16.         If d(s) > max Then max = d(s): maxType = sType
    
17.       End If
    
18.     Next
    
19.    
    
20.     .[J1].Value = maxType
    
21.     .[J2].Value = max
    
22.   End With
    
23.   
    
24. End Sub

複製代碼

yen956

回復 2# stillfish00
大大你好:
對於 dictionary 的運作, 一直都很好奇,
看了大大的傑作, 又增加了幾分了解與困惑,
先收下再研究啦, 謝謝!!

ii31sakura

回復 2# stillfish00

很感謝stillfish00前輩 這麼熱心幫忙解決小弟的困擾、
讓想了好幾天的問題總是可以得到幫助，
再一次在此謝過後小弟再來收下研究了。
    感謝大大~

GBKEE

回復 4# ii31sakura


   

統計出現最多次數目與項目

當出現最多次數目不只ㄧ項時

1. Sub Test()
   
2.   Dim r As Long, sCond As String
   
3.   Dim d As Object, k As Variant
   
4.   Set d = CreateObject("scripting.dictionary")
   
5.   With Sheets("Data")
   
6.     sCond = .[G1].Text
   
7.     r = .Cells(.Rows.Count, "A").End(xlUp).Row - 1
   
8.     If r <= 0 Then Exit Sub
   
9.     For Each s In .[A2].Resize(r).Value
   
10.       If sCond = Split(s, "-")(0) Then d(s) = d(s) + 1
    
11.     Next
    
12.     r = 0
    
13.     For Each k In d.keys
    
14.         If d(k) = Application.WorksheetFunction.max(d.ITEMS) Then '出現最多次數目
    
15.             With .[J1].Offset(, r)
    
16.                .Value = Split(k, "-")(1)
    
17.                 .Offset(1).Value = d(k)
    
18.             End With
    
19.             r = r + 1
    
20.         End If
    
21.     Next
    
22.   End With
    
23. End Sub

複製代碼

ii31sakura

回復 5# GBKEE

感謝GBKEE前輩提供小弟另一個方向操作與思考、很謝謝stillfish00與GBKEE兩位前輩的熱心幫忙~