ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

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

¦^´_ 20# yliu

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

TOP

¦^´_ 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.     t1 = Timer
  7.     Application.ScreenUpdating = False
  8.     '  Application.Calculation = xlCalculationManual

  9.     AllType = Array("AÃþ", "BÃþ", "CÃþ", "DÃþ", "EÃþ", "FÃþ", "GÃþ", "HÃþ", "IÃþ", "JÃþ")
  10.     ReDim SubTotalAr(0 To UBound(AllType), 0 To 16)
  11.    '  ²M²z¼ƾÚ
  12.     Sheets("Á`ªí").Activate
  13.     Sheets("Á`ªí").Range("A3").CurrentRegion.Offset(1, 1).Clear

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

TOP

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

°õ¦æ«e:


°õ¦æµ²ªG:



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
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¡i®É¤é²öªÅ¹L¡j¤@­Ó¤H¦b¥@¶¡°µ¤F¦h¤Ö¨Æ¡A´Nµ¥©ó¹Ø©R¦³¦hªø¡C¦]¦¹¥²¶·»P®É¶¡Ävª§¡A¤Á²ö¨Ï®É¤éªÅ¹L¡C
ªð¦^¦Cªí ¤W¤@¥DÃD