Board logo

標題: 計算不重複資料出現次數 [已解決] [打印本頁]
作者: loyyee    時間: 2011-9-4 17:52     標題: 計算不重複資料出現次數 [已解決]

本帖最後由 loyyee 於 2011-9-17 00:06 編輯

請問要如何用巨集計算下列不重複資料出現次數?
         A             B
1  0001        A1
2  0001        A2
3  0001        A2
4  0001        A3
5  0002        A1
6  0002        B1
7  0002        B1
8  0002        B1

得到結果：0001出現不重複次數=3、0002出現不重複次數=2
作者: dechiuan999    時間: 2011-9-4 19:34

本帖最後由 dechiuan999 於 2011-9-4 19:41 編輯

你好：
  請問你的計算基礎為何呢？
如果以0002出現不重覆次數為=2時，
想必是以A及B合併為KEY值，
0002A1 一次
0002B1 三次，不重覆次數為二
那0001應為1次才合理。
0001如何計算不重覆次數為=3呢？
如果上述推理正確時，請試試下列語法
Sub aa()
   
    '請先由工具列引用Microsoft Scripting Rungtime
   
    Dim mDic As Scripting.Dictionary
    Dim mSht As Worksheet
    Dim mRng As Range, mRng1 As Range
    Dim E As Range
    Dim mTmp, mVal
    Dim i%
   
    Set mDic = CreateObject("scripting.dictionary")
    Set mSht = Worksheets(1)
    With mSht
        Set mRng = .Range("a1", Range("a" & .Rows.Count).End(xlUp))
            For Each E In mRng
                If Not E.Value = Empty Then
                    If Not mDic.Exists(E.Value & "_" & E.Offset(, 1).Value) Then
                        mDic(E.Value & "_" & E.Offset(, 1).Value) = 1
                        
                    Else
                        mDic(E.Value & "_" & E.Offset(, 1).Value) = mDic(E.Value & "_" & E.Offset(, 1).Value) + 1
                    End If
                    
                End If
            Next
            
            For Each E In mRng
                E.Offset(, 3).Value = E.Value & "_" & E.Offset(, 1).Value
            Next
            
            mKey = mDic.Keys
         
            For i = LBound(mKey) To UBound(mKey)
               mVal = mDic(mKey(i))
               If mVal > 1 Then
                  Set mRng1 = mSht.Columns(4).Find(what:=mKey(i), lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlNext)
                  If Not mRng1 Is Nothing Then
                    mRng1.Offset(, -1).Value = mVal - 1
                  End If
                End If
            Next
            .Columns(4).ClearContents            
    End With            
End Sub
作者: loyyee    時間: 2011-9-4 21:42

回復 2# dechiuan999


    您好，抱歉沒說清楚，A.B欄位是要合併起來看才對。
0001 出現:A1.A2.A3=3次
作者: Hsieh    時間: 2011-9-4 22:00

  1. Sub nn()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. For Each a In Range([A1], [A1].End(xlDown))
  4.   If IsEmpty(d(a.Value)) Then
  5.      d(a.Value) = a.Offset(, 1)
  6.   ElseIf IsError(Application.Match(a.Offset(, 1), Split(d(a.Value), ","), 0)) Then
  7.      d(a.Value) = d(a.Value) & "," & a.Offset(, 1)
  8.   End If
  9. Next
  10. For Each ky In d.keys
  11.   d(ky) = Array(ky, UBound(Split(d(ky), ",")) + 1)
  12. Next
  13. [C1].Resize(d.Count, 2) = Application.Transpose(Application.Transpose(d.items))
  14. End Sub
複製代碼
回復 3# loyyee
作者: loyyee    時間: 2011-9-6 11:14

回復 4# Hsieh

感謝Hsieh程式可以用了。
再請問一下如何在 F3儲存格加入註解顯示計算出來的結果：

註解內容如下~

0001 次數=3
0002 次數=2
筆數：2 (因出現：0001、0002二筆資料)
作者: Hsieh    時間: 2011-9-6 14:27

回復 5# loyyee
  1. Sub nn()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. For Each a In Range([A1], [A1].End(xlDown))
  4.   If IsEmpty(d(a.Value)) Then
  5.      d(a.Value) = a.Offset(, 1)
  6.   ElseIf IsError(Application.Match(a.Offset(, 1), Split(d(a.Value), ","), 0)) Then
  7.      d(a.Value) = d(a.Value) & "," & a.Offset(, 1)
  8.   End If
  9. Next
  10. For Each ky In d.keys
  11.   d(ky) = Array(ky, UBound(Split(d(ky), ",")) + 1)
  12. If mystr = "" Then
  13.   mystr = Join(d(ky), "次數=")
  14.   Else
  15.   mystr = mystr & Chr(10) & Join(d(ky), "次數=")
  16. End If
  17. Next
  18. mystr = mystr & Chr(10) & "筆數= " & d.Count & "(因出現 : " & Join(d.keys, "、") & Application.Text(d.Count, "[DBNum1]") & "筆資料)"
  19. [C:E] = ""
  20. [C1].Resize(d.Count, 2) = Application.Transpose(Application.Transpose(d.items))
  21. [C1].Offset(d.Count, 3) = mystr
  22. End Sub
複製代碼
作者: loyyee    時間: 2011-9-12 14:27

感謝Hsieh程式可以用了。



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