標題: 請問如何計算出現次數, 但多於一個條件 [打印本頁]

---

作者: enoch    時間: 2011-10-2 00:38     標題: 請問如何計算出現次數, 但多於一個條件

請問如何計算生果出現次數,  但條件是日期等於8月1日, 及金額大於0

日期        生果        金額        計算結果
7月1日        橙        $10.00        
7月1日        蘋果        $0.00        
7月1日        香蕉        $20.00        
7月1日        橙        $0.00        
7月1日        蘋果        $5.00        
8月1日        香蕉        $0.00        
8月1日        橙        $5.00         橙1
8月1日        蘋果        $8.00         蘋果1
8月1日        香蕉        $0.00        
8月1日        橙        $35.00         橙2
8月1日        蘋果        $0.00        
8月1日        香蕉        $45.00         香蕉1
8月1日        橙        $0.00        
8月1日        蘋果        $8.00         蘋果2
8月1日        香蕉        $1.00         香蕉2
8月1日        橙        $8.00         橙3
8月1日        蘋果        $0.00        
8月1日        香蕉        $15.00         香蕉3

---

作者: dechiuan999    時間: 2011-10-2 12:29

你好：
請試試是否合適
Sub aa()   
    Dim mSht As Worksheet
    Dim mRng As Range, E As Range
    Dim mDic As Object
    Dim mDic1 As Object
    Dim mKey1
    Dim m%
    Dim mDate As Date
    Dim mStr$
   
    Set mDic = CreateObject("Scripting.Dictionary")
    Set mDic1 = CreateObject("Scripting.Dictionary")
    Set mSht = Worksheets(1)
    With mSht
        Set mRng = .Range("b2:b19")
            For Each E In mRng
                mStr = E.Value & "," & E.Offset(, -1).Value
                    
                If E.Offset(, 1).Value > 0 Then
                    mDic(mStr) = mDic(mStr) + 1
                    mDic1(E.Value) = mDic1(E.Value)
                End If
               
            Next
            
            mDate = "2011/8/1"
            mKey1 = mDic1.Keys
           
            For Each E In mRng
               
                If mDic.Exists(E.Value & "," & E.Offset(, -1).Value) Then
                    
                    If E.Offset(, -1).Value = mDate And E.Offset(, 1).Value > 0 Then
                        E.Offset(, 2).Value = E.Value
                    End If
                End If
            
            Next
            m = 1
            For s = 0 To mDic1.Count - 1
                For Each E In mRng
                    If E.Offset(, 2) <> "" And E.Offset(, 2).Value = mKey1(s) Then
                    
                        E.Offset(, 2).Value = E.Offset(, 2).Value & m
                        m = m + 1
                    End If
                Next
                    m = 1
            Next
    End With
   
    Set mDic = Nothing
    Set mDic1 = Nothing
    Set mSht = Nothing
   
End Sub

---

作者: Hsieh    時間: 2011-10-2 13:12

回復 1# enoch

1. Sub nn()
   
2. Dim d As Object, A As Range
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. For Each A In [B2:B19]
   
5. If A.Offset(, -1) = DateSerial(2011, 8, 1) And A.Offset(, 1) <> 0 Then d(A.Value) = d(A.Value) + 1: A.Offset(, 2) = A & d(A.Value)
   
6. Next
   
7. End Sub

複製代碼

---

作者: 棋語鳥鳴    時間: 2011-10-4 21:11

回復 3# Hsieh


    請問~如果範圍為整個月份，例如:8月份(8月1日~8月31日)，要如何修改此巨集??

---

作者: Hsieh    時間: 2011-10-4 21:30

回復 4# 棋語鳥鳴

1. Sub nn()
   
2. Dim d As Object, A As Range
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. For Each A In [B2:B19]
   
5. If format(A.Offset(, -1),"yyyy/mm") ="2011/08" And A.Offset(, 1) <> 0 Then d(A.Value) = d(A.Value) + 1: A.Offset(, 2) = A & d(A.Value)
   
6. Next
   
7. End Sub

複製代碼

---

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