c_c_lai

¦^´_  kimbal
ÁÂÁÂkimbal.
¦ý¥X²{°õ¦æ¶¥¬q¿ù»~¡¦13¡¦: «¬ºA¤£²Å¦X
°»¿ù¦b: With Sheets("Á`ªí").Cells( ...
yliu µoªí©ó 2013-5-31 12:30

¦^´_ 2# kimbal
¤£¦n·N«ä¡A§Úµy·L²K¥[¤F´X¦æ¡A§Æ±æ±zµ¥¯à¯º¯Ç¡I

1. Private Sub Ex()
   
2.     Dim rowcnt As Long, i As Long
   
3.     Dim lngVlookupRow As Long, lngCurrenMonth As Long, lngCurrValue As Long
   
4. 
   
5.     Application.ScreenUpdating = False
   
6.     Application.Calculation = xlCalculationManual
   
7. 
   
8.     '  ²M²z¼ƾÚ
   
9.     Sheets("Á`ªí").Activate
   
10.     Sheets("Á`ªí").Range("A3").CurrentRegion.Offset(1, 1).Clear
    
11. 
    
12. 
    
13.     Sheets("­ì©l¸ê®Æ").Activate
    
14.     With Sheets("­ì©l¸ê®Æ")
    
15.         rowcnt = .Cells(1, 1).CurrentRegion.Rows.Count
    
16.         For i = 2 To rowcnt
    
17.             lngCurrenMonth = 0
    
18.             If IsDate(.Cells(i, 2)) Then
    
19.                 lngCurrenMonth = Month(.Cells(i, 2))                                               '  ·í¦æ¤ë¥÷
    
20.             End If
    
21.             
    
22.             If lngCurrenMonth > 0 And Not (IsError(Application.Match(.Cells(i, 1), Sheets("Á`ªí").Range("A:A"), 0))) Then
    
23.                 lngVlookupRow = Application.Match(.Cells(i, 1), Sheets("Á`ªí").Range("A:A"), 0)    '  ·í¦æÃþ«¬¦bÁ`ªí¦æ¼Æ
    
24.                 lngCurrValue = .Cells(i, 3)
    
25.                 With Sheets("Á`ªí")
    
26.                     .Cells(lngVlookupRow, lngCurrenMonth + 1).Value = .Cells(lngVlookupRow, lngCurrenMonth + 1).Value + lngCurrValue                       '  ©ñ¼Æ¾Ú¨ìÁ`ªí¤W
    
27.                     .Cells(lngVlookupRow, "N") = .Cells(lngVlookupRow, "N") + lngCurrValue
    
28.                     .Cells(lngVlookupRow, Chr(79 + Int(lngCurrenMonth / 4))) = .Cells(lngVlookupRow, Chr(79 + Int(lngCurrenMonth / 4))) + lngCurrValue
    
29.                 End With
    
30.             End If
    
31.         Next
    
32.     End With
    
33.    
    
34.     With Sheets("Á`ªí")
    
35.         rowcnt = .[A3].End(xlDown).Row
    
36.         For i = 2 To 18
    
37.             .Cells(rowcnt, i) = WorksheetFunction.Sum(.Range(Chr(64 + i) & 4 & ":" & Chr(64 + i) & (rowcnt - 1)))
    
38.         Next i
    
39.     End With
    
40.    
    
41.     Application.Calculation = xlCalculationAutomatic
    
42.     Application.ScreenUpdating = True
    
43. End Sub

½Æ»s¥N½X

c_c_lai

½Ð±N 4 §ï¦¨ 3.2

1.                     .Cells(lngVlookupRow, Chr(79 + Int(lngCurrenMonth / 3.2))) = .Cells(lngVlookupRow, Chr(79 + Int(lngCurrenMonth /3.2))) + lngCurrValue

½Æ»s¥N½X

c_c_lai

¦pªþ¥ó¡G
¨â­Ó±ø¥óªº¥[Á`.rar (20.85 KB)

¤U¸ü¦¸¼Æ: 15

2013-5-31 21:16

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

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

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