Hsieh

回復 1# oiggu
選取d3儲存格,加入定義名稱x
公式=OFFSET(Sheet1!$A:$A,,,COUNTA(Sheet1!$A:$A),)

下載 (11.34 KB)

2010-7-24 17:02

d3陣列公式
{=IF(ISNUMBER(MATCH($C3&D$2,LEFT(x,5),0)),SUM(1/COUNTIF(OFFSET($A$1,MATCH($C3&D$2,LEFT(x,5),0)-1,,COUNTIF(x,"="&$C3&D$2&"*")),OFFSET($A$1,MATCH($C3&D$2,LEFT(x,5),0)-1,,COUNTIF(x,"="&$C3&D$2&"*")))),0)}
向下向右複製

Hsieh

回復 5# oiggu

1. Sub MyCount()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. With Sheet1
   
4. For Each a In .Range(.[A1], .[A65536].End(xlUp))
   
5.    If d(Left(a, 5)) = "" Then
   
6.       d(Left(a, 5)) = a
   
7.       ElseIf InStr(d(Left(a, 5)), a) = 0 Then
   
8.       d(Left(a, 5)) = d(Left(a, 5)) & "," & a
   
9.     End If
   
10. Next
    
11. For Each a In .[C3:C5]
    
12.    For Each b In .[D2:F2]
    
13.       .Cells(a.Row, b.Column) = UBound(Split(d(a & b), ",")) + 1
    
14.     Next
    
15. Next
    
16. End With
    
17. End Sub

複製代碼

Hsieh

回復 7# oiggu

1. Sub MyCount()
   
2. 
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. 
   
6. With Sheet1
   
7. 
   
8. For Each a In .Range(.[A1], .[A65536].End(xlUp))
   
9. d1(Left(a, 5)) = d1(Left(a, 5)) + Application.Sum(a.Offset(, 1).Resize(, 3))
   
10.    If d(Left(a, 5)) = "" Then
    
11. 
    
12.       d(Left(a, 5)) = a
    
13. 
    
14.       ElseIf InStr(d(Left(a, 5)), a) = 0 Then
    
15. 
    
16.       d(Left(a, 5)) = d(Left(a, 5)) & "," & a
    
17. 
    
18.     End If
    
19. 
    
20. Next
    
21. 
    
22. For Each a In .[F5:F7]
    
23. 
    
24.    For Each b In .[G3:L3]
    
25.       
    
26.      If (b.Column Mod 2) = 1 Then Cells(a.Row, b.Column) = UBound(Split(d(a & b), ",")) + 1
    
27.      If (b.Column Mod 2) = 0 Then Cells(a.Row, b.Column) = d1(a & b)
    
28. 
    
29.     Next
    
30. 
    
31. Next
    
32. 
    
33. End With
    
34. 
    
35. End Sub

複製代碼

Hsieh

回復 10# oiggu
可見你對程式碼並未真正了解含意
況且這種統計用樞紐分析很快就能解決
建議你先把EXCEL基本功能了解
VBA是輔助工具
有了基本操作的基礎,VBA的運用才會靈活

    test.rar (16.58 KB)

下載次數: 4

2010-7-29 19:50

下載 (10.36 KB)

2010-7-29 22:23

1. Sub nn()
   
2. Dim A As Range, B As Range
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. With Sheets("DATE")
   
5.    For Each A In .Range(.[B1], .[B1].End(xlToRight))
   
6.       For Each B In .Range(.[A2], .[A2].End(xlDown))
   
7.          d(A & B) = d(A & B) + Val(.Cells(A.Column, B.Row))
   
8.       Next
   
9.    Next
   
10. End With
    
11. With Sheets("A")
    
12.    For Each A In .Range(.[B1], .[B1].End(xlToRight))
    
13.       For Each B In .Range(.[A3], .[A3].End(xlDown))
    
14.          .Cells(A.Column, B.Row) = d(A & B)
    
15.       Next
    
16.    Next
    
17. End With
    
18. 
    
19. End Sub

複製代碼