[µo°Ý] 2­Ó±ø¥óªº¥[Á`

yliu

½Ð°Ý¦U¦ì°ª¤â,

§Ú­n±N­ì©l¸ê®Æ¸Ì¨ÌÃþ§O»P¤é´Á³o¨â­Ó±ø¥ó±Nª÷ÃB¥[Á`¨ì"Á`ªí",¨Ò¦p:1/1~1/31, AÃþª÷ÃB¥[Á`«á©ñ¨ìB4Àx¦s®æ,2/1~2/28, AÃþª÷ÃB¥[Á`«á©ñ¨ìC4Àx¦s®æ,3/1~3/31, AÃþª÷ÃB¥[Á`«á©ñ¨ìD4Àx¦s®æ..¥H¦¹Ãþ±À
­ì¥»¨Ï¥Î¤u§@ªí¨ç¼ÆSUMPRODUCT, ¦ý¸ê®Æ¶q¦h®É,¤u§@ªírun­«·s­pºâ·|ªá«Ü¦h®É¶¡, ·Q§ï¥ÎVBA¤è¦¡.
¦ý§Ú¥u·|¥Î¤U¦C¼gªk,µo²{³o¼Ë¼gªk­n¼g«Ü¦hªºIF§PÂ_,·Q½Ð°Ý¦U¦ì°ª¤â ´£¨Ñ¸û¦nªº¼gªk.·PÁÂ!

Private Sub CommandButton2_Click()
Dim rowcnt As Integer
Dim i As Integer
Dim sum_A_1, sum_A_2, sum_A_3,sum_A_4,sum_A_5,sum_A_6,sum_A_7,sum_A_8,sum_A_9,sum_A_10,sum_A_11,sum_A_12 As Variant
sum_A_1= 0 '²Î­pAÃþ1¤ë¥÷ª÷ÃB
sum_A_2= 0 '²Î­pAÃþ2¤ë¥÷ª÷ÃB
sum_A_3= 0 '²Î­pAÃþ3¤ë¥÷ª÷ÃB
sum_A_4= 0 '²Î­pAÃþ4¤ë¥÷ª÷ÃB
sum_A_5= 0 '²Î­pAÃþ5¤ë¥÷ª÷ÃB

Sheets("­ì©l¸ê®Æ").Activate
With Sheets("­ì©l¸ê®Æ")
rowcnt= .Cells(1, 1).CurrentRegion.Rows.Count

For i = 1 To rowcnt
    '¥[Á`AÃþ¤@¤ë¥÷ª÷ÃB
    If .Cells(i,2) >= "2013/1/1"And .Cells(i, 2) <= "2013/1/31" And .Cells(i,1) = Sheets("Á`ªí").Range("A4") Then
        sum_A_1= sum_A_1 + (Cells(i, 3).Value)
        Sheets("Á`ªí").Range("B4") = sum_A_1
    End If
   '¥[Á`AÃþ¤G¤ë¥÷ª÷ÃB
     If .Cells(i,2) >= "2013/2/1"And .Cells(i, 2) <= "2013/2/28" And .Cells(i,1) = Sheets("Á`ªí").Range("A4") Then
        sum_A_2= sum_A_2+ (Cells(i, 3).Value)
        Sheets("Á`ªí").Range("C4") = sum_A_2   
     End If
Next

End With
End Sub

¤U¸ü (59.32 KB)
­ì©l¸ê®Æ

2013-5-30 23:04

¤U¸ü (62.72 KB)
Á`ªí

2013-5-30 23:06

Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

°õ¦æ«e:

¤U¸ü (71.4 KB)

2023-4-26 16:44

°õ¦æµ²ªG:

¤U¸ü (150.53 KB)

2023-4-26 16:45

Option Explicit
Sub TEST()
Dim Brr, Crr, Y, i&, j&, T1$, T2$, T3%
Dim Sh1 As Worksheet, Sh2 As Worksheet
Set Y = CreateObject("Scripting.Dictionary")
Set Sh1 = Sheets("­ì©l¸ê®Æ"): Set Sh2 = Sheets("Á`ªí")
Brr = Range(Sh1.[C2], Sh1.Cells(Rows.Count, "A").End(3))
Sh2.[B4:R14].ClearContents: Crr = Sh2.[A3:R14]
For i = 1 To UBound(Brr)
   T1 = Brr(i, 1): T2 = Format(Brr(i, 2), "M¤ë"): T3 = Brr(i, 3)
   Y(T1 & "|" & T2) = Y(T1 & "|" & T2) + T3
Next
For i = 2 To UBound(Crr) - 1
   For j = 2 To 13: Crr(i, j) = 0 + Y(Crr(i, 1) & "|" & Crr(1, j)): Next
Next
With Sh2
   .[A3:R14] = Crr
   .[N4:N13] = "=SUM(B4:M4)"
   .[O4:O13] = "=SUM(B4:D4)"
   .[P4:P13] = "=SUM(E4:G4)"
   .[Q4:Q13] = "=SUM(H4:J4)"
   .[R4:R13] = "=SUM(K4:M4)"
   .[B14:R14] = "=SUM(B4:B13)"
End With
Set Y = Nothing: Set Sh1 = Nothing: Set Sh2 = Nothing: Erase Brr, Crr
End Sub

c_c_lai

¦^´_ 18# yliu
§Ú±N­ì¥» Kimbal ª©¤j´£¨Ñªº­×¥¿µ{¦¡¦b¤©¼W­×¡A
¥H¤Î sunnyso «e½ú´£¨Ñªºµ{¦¡²¤¤©­×¥¿«á¡A¼g¦¨¨â²Õ
®Ä¯q¤£¿ùªº¼Ò²Õ¡A¨Ñ©p¿ï¥Î¡C
A.  ¤§«e´£¨Ñªº¡A§ï¥H°}¦C³B²z (­ì¥»¬O¹ïÀ³¹êÅéÄæ¦ì¤@¤@³B²z)¡A
       ¸g­×¥¿«áªºµ{¦¡½X¡G

1. Sub Ex_Match_Case()         '  Match Case
   
2.     Dim RowsCnt As Long, i As Long, SubTotalAr() As Double
   
3.     Dim t1 As Variant, t2 As Variant, AllType As Variant
   
4.     Dim DataArea As Variant, Atype As Integer
   
5.     Dim lngCurrenMonth As Long, lngCurrValue As Long
   
6. 
   
7.     t1 = Timer
   
8.     Application.ScreenUpdating = False
   
9.     '  Application.Calculation = xlCalculationManual
   
10. 
    
11.     AllType = Array("AÃþ", "BÃþ", "CÃþ", "DÃþ", "EÃþ", "FÃþ", "GÃþ", "HÃþ", "IÃþ", "JÃþ")
    
12.     ReDim SubTotalAr(0 To UBound(AllType), 0 To 16)
    
13.    '  ²M²z¼ƾÚ
    
14.     Sheets("Á`ªí").Activate
    
15.     Sheets("Á`ªí").Range("A3").CurrentRegion.Offset(1, 1).Clear
    
16. 
    
17.     Sheets("­ì©l¸ê®Æ").Activate
    
18.     With Sheets("­ì©l¸ê®Æ")
    
19.         RowsCnt = .Cells(1, 1).CurrentRegion.Rows.Count
    
20.         DataArea = .Range("A2").Resize(RowsCnt - 1, 3)
    
21.         
    
22.         For i = 1 To UBound(DataArea)
    
23.             lngCurrenMonth = 0
    
24.             If IsDate(DataArea(i, 2)) Then
    
25.                 lngCurrenMonth = Month(DataArea(i, 2))                                               '  ·í¦æ¤ë¥÷
    
26.             End If
    
27.             
    
28.             If lngCurrenMonth > 0 Then
    
29.                 lngCurrValue = DataArea(i, 3)
    
30.                         
    
31.                 For Atype = 0 To UBound(AllType)                '  AÃþ To JÃþ
    
32.                     If DataArea(i, 1) = AllType(Atype) Then     '  Jan To Dec
    
33.                         SubTotalAr(Atype, lngCurrenMonth - 1) = SubTotalAr(Atype, lngCurrenMonth - 1) + lngCurrValue
    
34.                         SubTotalAr(Atype, 12) = SubTotalAr(Atype, 12) + lngCurrValue     '  ²Ö­p
    
35.                         SubTotalAr(Atype, 13 + Int(lngCurrenMonth / 3.2)) = SubTotalAr(Atype, 13 + Int(lngCurrenMonth / 3.2)) + lngCurrValue
    
36.                         '  °£¥H 3.2¡G
    
37.                         '  1 (Int(0.3125)=0)¡A  2 (Int(0.625))=0 )¡A 3 (Int(0.9375))=0 )¡A  '  ²Ä¤@©u
    
38.                         '  4 (Int(1.25))=1)¡A   5 (Int(1.5625))= 1)¡A6 (Int(1.875 ))=1)¡A   '  ²Ä¤G©u
    
39.                         '  7 (Int(2.1875))= 2)¡A8 (Int(2.5))=2 )¡A   9 (Int(2.8125))=2)¡A   '  ²Ä¤T©u
    
40.                         '  10(Int(3.125))=3)¡A  11(Int(3.4375 ))=3)¡A12(Int(3.75))=3)       '  ²Ä¥|©u
    
41.                         '  *************************************************************************************
    
42.                     End If
    
43.                 Next Atype
    
44.             End If
    
45.         Next i
    
46.     End With
    
47.    
    
48.     With Sheets("Á`ªí")
    
49.         .Range("B4").Resize(UBound(AllType) + 1, 17) = SubTotalAr
    
50.         '  RowsCnt = .[A3].End(xlDown).Row
    
51.         ' For i = 2 To 18
    
52.         '      .Cells(RowsCnt, i) = WorksheetFunction.Sum(.Range(Chr(64 + i) & 4 & ":" & Chr(64 + i) & (RowsCnt - 1)))   '  ¦X­p
    
53.         '  Next i
    
54.         .Range("B14:R14").FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    
55.     End With
    
56.    
    
57.     '  Application.Calculation = xlCalculationAutomatic
    
58.     Application.ScreenUpdating = True
    
59.     t2 = Timer
    
60.     '  MsgBox "¯Ó®É" & t2 - t1
    
61.     Sheets("­ì©l¸ê®Æ").[F11] = "¯Ó®É¡G " & CDbl(t2 - t1)
    
62. End Sub

½Æ»s¥N½X

B.  ¸g´ú¸Õ¡A®Ä¯q³Ì¨Îªºµ{¦¡¼Ò²Õ¡G

1. Sub Ex_VBA_Array()          '  VBA Code DataArea Array
   
2.     Dim RowsCnt As Long, m As Long, SubTotalAr() As Double
   
3.     Dim t1 As Variant, t2 As Variant, AllType As Variant
   
4.     Dim DataArea As Variant
   
5.     Dim i%, j%
   
6.    
   
7.     t1 = Timer
   
8.     AllType = Array("AÃþ", "BÃþ", "CÃþ", "DÃþ", "EÃþ", "FÃþ", "GÃþ", "HÃþ", "IÃþ", "JÃþ")
   
9.     ReDim SubTotalAr(0 To UBound(AllType), 0 To 11)
   
10.     Application.ScreenUpdating = False
    
11.    
    
12.     '  ²M²z¼ƾÚ
    
13.     '  Sheets("Á`ªí").Activate
    
14.     Sheets("Á`ªí").Range("A3").CurrentRegion.Offset(1, 1).Clear
    
15.    
    
16.     With Sheets("­ì©l¸ê®Æ")
    
17.         RowsCnt = .Range("A1").CurrentRegion.Rows.Count
    
18.         DataArea = .Range("A2").Resize(RowsCnt - 1, 3)
    
19.         
    
20.         For m = 1 To UBound(DataArea)
    
21.             For i = 0 To UBound(AllType)                '  AÃþ To JÃþ
    
22.                 If DataArea(m, 1) = AllType(i) Then     '  Jan To Dec
    
23.                     SubTotalAr(i, Month(DataArea(m, 2)) - 1) = SubTotalAr(i, Month(DataArea(m, 2)) - 1) + DataArea(m, 3)
    
24.                 End If
    
25.             Next i
    
26.         Next m
    
27.     End With
    
28.    
    
29.     With Sheets("Á`ªí")
    
30.         .Range("B4").Resize(UBound(AllType) + 1, 12) = SubTotalAr
    
31.         .Range("N4:N13").FormulaR1C1 = "=SUM(RC[-12]:RC[-1])"
    
32.         For i = 0 To 3
    
33.             '  .Range(Chr(79 + i) & 4 & ":" & Chr(79 + i) & 13).FormulaR1C1 = "=SUM(RC[-" & (13 - i * 2) & "]:RC[-" & (11 - i * 2) & "])"
    
34.             .Range(Chr(79 + i) & 4).Resize(UBound(AllType) + 1).FormulaR1C1 = "=SUM(RC[-" & (13 - i * 2) & "]:RC[-" & (11 - i * 2) & "])"
    
35.             .Range(Chr(79 + i) & 4).Resize(UBound(AllType) + 1) = .Range(Chr(79 + i) & 4).Resize(UBound(AllType) + 1).Value
    
36.         Next i
    
37.         .Range("B14:R14").FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)"
    
38.     End With
    
39.     Application.ScreenUpdating = True
    
40.     t2 = Timer
    
41.     '  MsgBox "¯Ó®É" & t2 - t1
    
42.     Sheets("­ì©l¸ê®Æ").[F3] = "¯Ó®É¡G " & CDbl(t2 - t1)
    
43. End Sub

½Æ»s¥N½X

¥H¤W¨â²Õ¼Ò²Õ¡A§¡¨Ï¥Î 70 µ§¡B¥H¤Î 52,993 µ§¤§¸ê®Æ (sunnyso «e½ú´£¨Ñ) ´ú¸Õ¹L¡C
©p¥i¥H¦Û¦æ´ú´ú¬Ý¡C

sunnyso

¦^´_ 20# yliu

Ãþ§O°}¦C¥i¥H±qÁ`ªíŪ¨ú, ¤]¥i¥H±q­ì©l¸ê®ÆªíAÄæ§â¤£­«´_ªºÅª¥X¡]¨Ò¦p¦r¨åªk¡^

yliu

¦^´_ 16# sunnyso

½Ð°Ý: µ{¦¡½X¤¤...Array("AÃþ", "BÃþ", "CÃþ", "DÃþ", "EÃþ", "FÃþ", "GÃþ", "HÃþ", "IÃþ", "JÃþ")
§Y­Y±Ä¥Î°}¦C,  ´N¬O·í¦³·sªºÃþ§O¶µ¥Ø®É, ´N»Ý­×§ïµ{¦¡½X,¨Ò¦p¡G¤é«á¥i¯à·s¼WKÃþ®É, ´N»Ý­×§ïµ{¦¡¬O¶Ü¡H
¨º±Ä¥Î°}¦C¤è¦¡´N·|¨ü­­¨î,¬O§_¦³§Oªº¤è¦¡©O¡H

yliu

¦^´_ 14# sunnyso

¥Ø«e²Ö¿n¸ê®Æ¬O700µ§¥ª¥k, ¨ì¦~©³À³¸Ó·|¦³2000µ§.
¥»¨Ó¥uª¾¹DSUMIF ¨ç¼Æ, ¦ýSUMIF¨ç¼Æ¥u­­¥Î©ó³æ¤@±ø¥ó, ÁÂÁ´£¨ÑSUMIFS.
¦ýSUMIFSÀ³¸Ó¬O2010ª©¥»¤~¦³ªº¨ç¼Æ.

yliu

¦^´_ 15# c_c_lai

ÁÂÁ¸Բӻ¡©ú

c_c_lai

¦^´_ 16# sunnyso
SUMIFS ªº³B²zªº½TÆZ²¼äªº¡A­È±o¬ã¨s¤ÎÀ³¥Î¡A
¥H©¹(¤u§@)§Ú¬O°¾­«©ó±q¨ÆÀ³¥Î³nÅé»Pºô­¶À³¥Î¤è­±¡A
±qµL¾÷½t±µÄ²¹L Excel¡A°h¤U«á¬°À°§U¤Í¤H¤~¶}©l±µÄ²
Excel (·s¤â)¡A ¬O¬G¸û¤Ö¨Ï¥Î¦¹Ãþ¦ü¤§¨ç¼Æ¡A
ÁÂÁ§Aªº«ü±Ð¡I ¥¦¹ï§ÚÆZ¦³§U¯qªº¡A¦A¦¸ÁÂÁ¡I

sunnyso

¦^´_ 15# c_c_lai

À³¸Ó§â¸ê®Æ¤@¦¸Åª¤J°}¦C, µM«á¦bVBA¤¤­pºâ¦¨°}¦C,³Ì«á§â­pºâ¦nªº°}¦C¦^¶Ç¨ì¤u§@ªí¡C
´î¤Öª«¥óŪ¼g¦¸¼ÆVBAªº®Ä²v¤~°ª

¥Ø«eµo²{VBAªº®Ä²v¤ñSUMIFS§C

¥i¥H°Ñ¦Ò³oùØ
http://forum.twbts.com/thread-9607-1-1.html

c_c_lai

¦^´_  c_c_lai


   ÁÂÁÂ c_c_lai,
   ¥i¥H¨Ï¥Î¤F, ·PÁÂ~
  ¦A½Ð°Ý¤@¤U,   
.Cells(lngVlookupRow, ...
yliu µoªí©ó 2013-5-31 23:53

¦pªG°£¥H 4¡G
1  ( Int(0.25)=0)¡A 2 ( Int(0.5))=0 )¡A     3( Int(0.75))=0 )¡A  '   ²Ä¤@©u (À³¬° 0)
4(  Int(1))=1)¡A      5( Int(1.25))= 1)¡A    6( Int(1.5 ))=1)¡A    '   ²Ä¤G©u (À³¬° 1)
7( Int(1.75))= 1)¡A 8( Int(2))=2 )¡A         9(  Int(2.25))=2)¡A   '  ²Ä¤T©u (À³¬° 2)
10(  Int(2.5))=2)¡A 11( Int(2.75 ))=2)¡A12(  Int(3))=3)          '  ²Ä¥|©u (À³¬° 3)
°£¥H 3.2¡G
1  ( Int(0.3125)=0)¡A 2 ( Int(0.625))=0 )¡A     3( Int(0.9375))=0 )¡A '   ²Ä¤@©u
4(  Int(1.25))=1)¡A      5( Int(1.5625))= 1)¡A   6( Int(1.875 ))=1)¡A    '   ²Ä¤G©u
7( Int(2.1875))= 2)¡A 8( Int(2.5))=2 )¡A           9(  Int(2.8125))=2)¡A '  ²Ä¤T©u
10(  Int(3.125))=3)¡A 11( Int(3.4375 ))=3)¡A12(  Int(3.75))=3)       '  ²Ä¥|©u
µ²½×¡G .Cells(lngVlookupRow, Chr(79 + Int(lngCurrenMonth / 3.2))) =
              .Cells(lngVlookupRow, Chr(79 + Int(lngCurrenMonth / 3.2))) + lngCurrValue
1¤ë  ¡G.Cells(lngVlookupRow, Chr(79 + 0)) = .Cells(lngVlookupRow, Chr(79 + 0)) + lngCurrValue
             .Cells(lngVlookupRow, "O") = .Cells(lngVlookupRow, "O") + lngCurrValue    '  ²Ä¤@©u
7¤ë  ¡G.Cells(lngVlookupRow, Chr(79 + 2)) = .Cells(lngVlookupRow, Chr(79 + 2)) + lngCurrValue
             .Cells(lngVlookupRow, "Q") = .Cells(lngVlookupRow, "Q") + lngCurrValue    '  ²Ä¤T©u
11¤ë¡G.Cells(lngVlookupRow, Chr(79 + 3)) = .Cells(lngVlookupRow, Chr(79 + 3)) + lngCurrValue
             .Cells(lngVlookupRow, "R") = .Cells(lngVlookupRow, "R") + lngCurrValue     '  ²Ä¥|©u
¦¹½×±oª¾¡A¦p¥H 3.2 §@¬°¤À¥À°£¤§¡B¦A¥H Int() ¨Ó¹LÂo¡A±o­È±o¥H¥¿½TÅã¥Ü¡A¤£­PÂkÃþ¿ù»~¡C