GBKEE

¦^´_ 4# gctsai
¥ý¾Ç°ò¥»¥\  3¼Ó´£Ä³ªº¤u§@ªí¨ç¼ÆSUMPRODUCT
¹Ï¤@  SHEET1 (¸ê®Æ°Ï)

¤U¸ü (15.5 KB)

2011-7-22 07:31

¹Ï¤G SHEET2

¤U¸ü (22.69 KB)

2011-7-22 07:31

¼Æ¶qªº¤½¦¡
B5=SUMPRODUCT((Sheet1!$A$2:$A$65525=$A$2)*(Sheet1!$B$2:$B$65525=$B$2)*(Sheet1!$C$2:$C$65525=$C$2)*(Sheet1!$D$2:$D$65535=A5))
B6=SUMPRODUCT((Sheet1!$A$2:$A$65525=$A$2)*(Sheet1!$B$2:$B$65525=$B$2)*(Sheet1!$C$2:$C$65525=$C$2)*(Sheet1!$D$2:$D$65535=A6))
B7=SUMPRODUCT((Sheet1!$A$2:$A$65525=$A$2)*(Sheet1!$B$2:$B$65525=$B$2)*(Sheet1!$C$2:$C$65525=$C$2)*(Sheet1!$D$2:$D$65535=A7))
B8=SUMPRODUCT((Sheet1!$A$2:$A$65525=$A$2)*(Sheet1!$B$2:$B$65525=$B$2)*(Sheet1!$C$2:$C$65525=$C$2)*(Sheet1!$D$2:$D$65535=A8))

GBKEE

¦^´_ 6# gctsai
VBAµ{§Ç¬O­n¶q¨­®M»sªº,©Ò¥HªþÄÒ¤W¨Ó³W©w±ø¥ó­n©ñ¨º¸Ì»¡©ú¥Õ, ¦^µª¤~·|©ú½T.

GBKEE

¦^´_ 8# gctsai
¸Õ¸Õ¬Ý

1. Sub Ex()
   
2.     Dim D As Object, Rng As Range
   
3.     Set D = CreateObject("SCRIPTING.DICTIONARY") '³]¥ß¦r¨åª«¥ó
   
4.     Set Rng = Sheets("¨Ó·½").[A2]                                       '³]¥ßÀx¦s®æª«¥ó
   
5.     With Sheets("²Î­p")
   
6.         Do While Rng <> ""        'Rngªº­È¬°ªÅ¥Õ®É¤£°õ¦æ Doªº°j°é
   
7.             If Rng = .[A2] Then D(Rng.Offset(, 1).Value) = D(Rng.Offset(, 1).Value) + 1
   
8.             '        .[A2] ->Sheets("²Î­p")[A2]      '¦r¨åª«¥ó(KEY)=ITEM + 1
   
9.             Set Rng = Rng.Offset(1)  'Rng¤U²¾¤@¦C¦ì
   
10.         Loop
    
11.         With .[B2:C2]
    
12.             .Cells(1).Resize(D.Count) = Application.Transpose(D.KEYS)
    
13.             .Cells(2).Resize(D.Count) = Application.Transpose(D.ITEMS)
    
14.             .Resize(D.Count, 2).Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
    
15.         End With
    
16.     End With
    
17.     Set D = Nothing
    
18.     Set Rng = Nothing
    
19. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 11# gctsai
¨Ï¥Î¤u§@ªíªº¹w³]¨Æ¥óWorksheet_Change,³o¬O§Aªþ¥óSheets("¨Ó·½")ªºµ{¦¡½X.

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Ex
   
3. End Sub
   
4. Private Sub Ex()
   
5.     Dim D As Object, Rng As Range
   
6.     Set D = CreateObject("SCRIPTING.DICTIONARY") '³]¥ß¦r¨åª«¥ó
   
7.     Set Rng = Sheets("¨Ó·½").[A2]                                       '³]¥ßÀx¦s®æª«¥ó
   
8.     With Sheets("²Î­p")
   
9.         Do While Rng <> ""        'Rngªº­È¬°ªÅ¥Õ®É¤£°õ¦æ Doªº°j°é
   
10.             If Rng = .[A2] Then D(Rng.Offset(, 1).Value) = D(Rng.Offset(, 1).Value) + 1
    
11.             '        .[A2] ->Sheets("²Î­p")[A2]      '¦r¨åª«¥ó(KEY)=ITEM + 1
    
12.             Set Rng = Rng.Offset(1)  'Rng¤U²¾¤@¦C¦ì
    
13.         Loop
    
14.         With .[B2:C2]
    
15.             .Cells(1).Resize(D.Count) = Application.Transpose(D.KEYS)
    
16.             .Cells(2).Resize(D.Count) = Application.Transpose(D.ITEMS)
    
17.             .Resize(D.Count, 2).Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
    
18.         End With
    
19.     End With
    
20.     Set D = Nothing
    
21.     Set Rng = Nothing
    
22. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 16# gctsai
¨º¦pªG­n²Î­pªºÄæ¦ì¤£¦b®ÇÃä©O
¨º§A­n¸ò¹q¸£»¡ªü ¦p¹Ï

   

¤U¸ü (29.07 KB)

2011-7-30 10:10

1. Private Sub Ex()
   
2.     Dim D As Object, Rng As Range, f As Variant
   
3.     Set D = CreateObject("SCRIPTING.DICTIONARY") '³]¥ß¦r¨åª«¥ó
   
4.     Set Rng = Sheets("¨Ó·½").[a2]    '³]¥ßÀx¦s®æª«¥ó
   
5.     With Sheets("²Î­p")
   
6.          f = Application.Match(.[b1].Text, Sheets("¨Ó·½").Rows(1), 0) 'f: ¦b¨Ó·½¤¤´M§ä²Î­pªºÄæ¦ì
   
7.          If IsError(f) Then MsgBox "²Î­pªºÄæ¦ì¤£¦s¦b!!!": Exit Sub
   
8.         Do While Rng <> ""        'Rngªº­È¬°ªÅ¥Õ®É¤£°õ¦æ Doªº°j°é
   
9.             If Rng = .Range("A2") Then D(Rng.Offset(, f - 1).Value) = D(Rng.Offset(, f - 1).Value) + 1
   
10.             '        .[A2] ->Sheets("²Î­p")[A2]      '¦r¨åª«¥ó(KEY)=ITEM + 1
    
11.             Set Rng = Rng.Offset(1)  'Rng¤U²¾¤@¦C¦ì
    
12.         Loop
    
13.         With .[B2:C2]
    
14.             .Resize(.CurrentRegion.Rows.Count, 2) = ""
    
15.             .Cells(1).Resize(D.Count) = Application.Transpose(D.KEYS)
    
16.             .Cells(2).Resize(D.Count) = Application.Transpose(D.ITEMS)
    
17.             .Resize(D.Count, 2).Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
    
18.         End With
    
19.     End With
    
20.     Set D = Nothing
    
21.     Set Rng = Nothing
    
22. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 24# gctsai
µ{§Ç¸Ì½Ð¥[¤W¬õ¦r³¡¤À
f = Application.Match(.[b1].Text, Sheets("¨Ó·½").Rows(1), 0) 'f: ¦b¨Ó·½¤¤´M§ä²Î­pªºÄæ¦ì
f = f - 2    '§AAÄæ±q²¾¨ìCÄæ ***** Rng.Offset·|§ïÅÜ
If Rng = .Range("A2") Then D(Rng.Offset(, f- 1).Value) = D(Rng.Offset(, f - 1).Value) + 1

GBKEE

¦^´_ 26# gctsai
­×§ï¦p¤U´N¥²¥h­pºâÄæ¦ì¤F

1. Sub Ex()
   
2.     Dim D As Object, Rng As Range, f As Variant
   
3.     Set D = CreateObject("SCRIPTING.DICTIONARY") '³]¥ß¦r¨åª«¥ó
   
4.     With Sheets("¨Ó·½")
   
5.         Set Rng = .[c2]    '³]¥ßÀx¦s®æª«¥ó
   
6.         f = Application.Match(Sheets("²Î­p").[b1].Text, .Rows(1), 0) 'f: ¦b¨Ó·½¤¤´M§ä²Î­pªºÄæ¦ì
   
7.         If IsError(f) Then MsgBox "²Î­pªºÄæ¦ì¤£¦s¦b!!!": Exit Sub
   
8.         Do While Rng <> ""        'Rngªº­È¬°ªÅ¥Õ®É¤£°õ¦æ Doªº°j°é
   
9.            If Rng = Sheets("²Î­p").Range("A2") Then D(.Cells(Rng.Row, f).Value) = D(.Cells(Rng.Row, f).Value) + 1
   
10.             '        .[A2] ->Sheets("²Î­p")[A2]      '¦r¨åª«¥ó(KEY)=ITEM + 1
    
11.             Set Rng = Rng.Offset(1)  'Rng¤U²¾¤@¦C¦ì
    
12.         Loop
    
13.     End With
    
14.     With Sheets("²Î­p").[B2:C2]
    
15.         .Resize(.CurrentRegion.Rows.Count, 2) = ""
    
16.         .Cells(1).Resize(D.Count) = Application.Transpose(D.KEYS)
    
17.         .Cells(2).Resize(D.Count) = Application.Transpose(D.ITEMS)
    
18.         .Resize(D.Count, 2).Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo
    
19.     End With
    
20.     Set D = Nothing
    
21.     Set Rng = Nothing
    
22. End Sub

½Æ»s¥N½X