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

[µo°Ý] ¦Û°Ê¤À°t¥æ´Á

¦^´_ 10# adam2010
    ÁÂÁ«e½ú´ú¸Õ¦^ÂÐ
°µ¤F¤ß±oµù¸Ñ§óµo²{¦Û¤v³\¦h¨S¥²­nªº¥i²¤Æªºµ{¦¡½X!
À˵ø¥X¤F«Ü¦hÅÞ¿è¤Wªº¯ÊÂI!
©ß¿j¤Þ¥É!½Ð«e½ú­Ì«ü¾É¦p¦ó²¤Æ!©Î¨ä¥L¤èªk! ÁÂÁÂ!
¥H¤U¤ß±o¨Ñ«e½ú°Ñ¦Ò
Option Explicit
Public PP&, Ch0, Ch1
Sub ¾î¦V©¹«eÅu¥­()
Application.ScreenUpdating = False
Dim Brr, Crr, i&, j&, x&, Tj&, Ti&, y, xA, Sc&, Sr&, R$
Dim Ra, Rs, Rn, Avgd&, Avgv, M0&, M1&, Sv, Cc, Bc, K, H
'¡ô«Å§iÅܼÆ
Ch0 = 0: Ch1 = 0
'¡ô¥OCh0¬O0,¥OCh1¬O0
Set xA = Sheets("PP").Cells
'¡ô¥OxA¬O "PP" ¤u§@ªíªº©Ò¦³Àx¦s®æ
Set y = CreateObject("Scripting.Dictionary")
'¡ô¥Oy¬O¦r¨å
For Each Ra In xA.SpecialCells(2)
'¡ô³]©w°j°é¥h§äxA«DªÅ®æ¸Ì¥k¤W¨¤¸ò¥ª¤U¨¤¬O "Á`­p" ªºÀx¦s®æ¦ì§}
   Rn = IIf(Ra = "Á`­p" And Rn = "" And Rs <> "", Ra.Address, Rn)
   '¡ô¥ORn¬O¥ª¤U¨¤ªº "Á`­p" Àx¦s®æ¦ì§}
   '§â³o¦æÂ\¦b«e­±ªº¥Î·N¬O:
   '¥k¤W¨¤ªº "Á`­p" Àx¦s®æ¦ì§}¦pªGÁÙ¨S§ä¨ì! And Rs <> ""³o±ø¥ó´N¤£¦¨¥ß
   'And Rn = ""¬O¥u»{©w²Ä¤G­Ó "Á`­p" Àx¦s®æ¦ì§}

   Rs = IIf(Ra = "Á`­p" And Rs = "", Ra.Address, Rs)
   '¡ô¥ORn¬O¥k¤W¨¤ªº "Á`­p" Àx¦s®æ¦ì§}
Next
Brr = xA.Range(Rs, Rn)
'¡ô¥OBrr¬O¨â­ÓÁ`­pÀx¦s®æ½d³òªº­È°}¦C
Bc = UBound(Brr, 2)
'¡ô¥OBc¬OBrr¾î¤è¦VªºÄæ¼Æ
Rs = Brr(1, 8)
'¡ô¥ORs¬O²Ä¤@¦C²Ä¤KÄæ³o­È(¦³­q³æªº¶}©l¤é´Á)
Rn = Brr(1, Bc - 1)
'¡ô¥ORn¬O²Ä¤@¦C­Ë¼Æ²Ä¤G­Ó­È(¦³­q³æªº³Ì«á¤é´Á)
Sc = Rn - Rs + 1
'¡ô¥OSc¬OÀY§À°Ï¶¡ªº¤Ñ¼Æ!¤@©w­n¥[1¤~¯à¥]§t³Ì«á¤@¤Ñ
Sr = UBound(Brr) - 2
'¡ô¥OSr¬OBrrªº¦C¼Æ´î±¼2¦C
Ch0 = Brr(UBound(Brr, 1), UBound(Brr, 2))
'¡ô¥OCh0¬O³Ì¥k¤U¨¤ªº­È(Á`¦X­p)
ReDim Crr(1 To Sr + 2, 1 To Sc + 1)
'¡ô«Å§iCrr³oªÅ°}¦Cªº½d³ò:Áa¤è¦VSr + 2 ¦C
'¾î¤è¦VSc + 1 Äæ

Cc = UBound(Crr, 2)
'¡ô¥OCc¬OCrrªº¾î¤è¦VÄæ¼Æ
For i = 1 To Sc
'¡ô³]°j°é§â¥þ³¡¤é´Á©ñ¨ìCrr°}¦Cªº²Ä¤@¦C
'¡ôy¦r¨å¤]¥Î³o¨Ç§Ç¸¹·íkey,item³]¬°0ªì©l­È,
'Åý«á­±²Ö¥[¬°·í¤ÑÅu¥­Á`©M

   Crr(1, i) = Rs + (i - 1)
   y(i) = 0
Next
For i = 1 To UBound(Brr)
'¡ô³]°j°é§â­ì©l¥k°¼ªº¤p­p©ñ¤JCrrªº³Ì«á¤@Äæ
   Crr(i, Cc) = Brr(i, Bc)
Next
For j = 2 To Sr + 1
'¡ô³]°j°é§â­ì©l©w³æ©ñ¤JCrrªº·í¤é­q³æ¦ì¸m
   For i = 1 To Sc
      For x = 8 To Bc - 1
         If Brr(1, x) = Rs + (i - 1) Then
            Crr(j, i) = Brr(j, x)
         End If
      Next
   Next
Next
For x = 1 To Sr
'¡ô¥H¤U³]¤T¼h°j°é§â­q³æ©¹«eÅu¥­!¥B¤£¥²¸ó¤ëÅu¥­!
'¡ô¥ý³]¥¿¥~°j°é

   Avgd = 0: Avgv = 0: M0 = 0: M1 = 0
   '¡ôAvgd:Åu¥­¤Ñ¼Æ,Avgv:Åu¥­¶q,
   'M0:«e¤@­Ó¤ëªº¤ë¼Æ,M1:·í®æªº¤ë¼Æ
   '°µÂk¹s

     For j = Sc To 1 Step -1
     '¡ô³]¤¤¼h­Ë°j°é!Åý²Å¦X±ø¥ó´N¶ñ¤JÅu¥­­È
     '¤£¯àÅu¥­´N¶ñ¤J­ì­q³æ­È
     '¨S¦³­q³æ´NªÅ®æ

      If j = 1 Then
         y(j) = y(j) + Crr(x + 1, j)
         Exit For
         '¡ô¦pªG­Ë°j°é¯à¶]¨ìj = 1,´NÅý¦X­p¥[¤W­ì­q³æ¶q
         ',´N¸õ¥X¤¤¼h³o°j°é

      End If
      M1 = Format(Crr(1, j), "mm")
      '¡ô¥OM1¬O·í®æªº­q³æ¤ë¥÷¼Æ
      Tj = Crr(x + 1, j)
      '¡ô¥OTj¬O­n§P©w¶·¤£¶·!¯à¤£¯àÅu¥­ªº·í®æ­È
      If Tj <> 0 And j = Sc Then
      '¡ô¦pªG·í®æ­È¤£¬O0 ¦Ó¥B¬O³Ì«á¤@­Ó¤é´Á­q³æ
         Avgd = 1
         '¡ô¥O¥iÅu¥­¤Ñ¼Æ=1
         For i = j - 1 To 1 Step -1
            '¡ô³]¤º¼h­Ë°j°é!±qj·í®æ«e¤@®æ¶}©l¨ì³Ì«e­±¨º¤Ñ
            M0 = Format(Crr(1, i), "mm")
            '¡ô¥OM0¬Oi·í®æªº¤ë¤À¼Æ
            Ti = Crr(x + 1, i)
            '¡ô¥OTi¬O­n§P©w¯à¤£¯à¦Y¤UÅu¥­­Èªº·í®æ
            If Ti <> 0 And Avgd = 1 Then
            '¡ô¦pªG«e¤è®æªº­È¤£¬O0,¥B¥iÅu¥­¤Ñ¼Æ¬O1
               If i = Sc - 1 Then
               '¡ô¦pªGi¬O­Ë¼Æ²Ä¤G¤Ñ
                  Avgd = 0
                  '¡ô±ø¥ó¦¨¥ß!´N¥iÅu¥­¤Ñ¼Æ=0
                  '¦]¬°¨S±oÅu¥­

                  Else
                     Avgd = Avgd + 1
                     Avgv = Tj
                     '¡ô§_«h¥iÅu¥­¤Ñ¼Æ+1
                     '¡ô¥i³QÅu¥­ªº¼Æ¶q´N¬Ojªº·í®æ­È

               End If
               y(j) = y(j) + Tj
               '¡ô·í¤Ñ¥þ³¡Åu¥­Á`©M­n²Ö¥[
               GoTo 111
               '¡ô¸õ¨ì 111ªº¦ì¸mÄ~Äò°õ¦æ
            End If
            If (Ti <> 0 And Avgd > 1) Or M0 <> M1 Then
            '¡ô(¦pªG«e¤è®æ¤£¬O0¥B¥iÅu¥­¤Ñ¼Æ¤j©ó1)©Î¤ë¼Æ¤w¸g¤£¤@¼Ë¤F
               GoTo 111
               '¡ô¸õ¨ì 111ªº¦ì¸mÄ~Äò°õ¦æ
            End If
            If Ti = 0 Then
            '¡ô¦pªG«e¤è®æ¬O0
               Avgd = Avgd + 1
               '¡ô¥iÅu¥­¤Ñ¼Æ+1
               Avgv = Round(Tj / Avgd, PP)
               '¡ôÅu¥­­È=¶·Åu¥­­È°£¥H¥iÅu¥­¤Ñ¼Æ¤§«á¥|±Ë¤­¤J¨ú¾ã¼Æ
            End If
         Next i
      End If
      If Tj <> 0 And j <> Sc Then
      '¡ô¦pªG·í®æ­È¤£¬O0 ¦Ó¥B¤£¬O³Ì«á¤@­Ó¤é´Á­q³æ
         Avgd = 1
         '¡ô¥O¥iÅu¥­¤Ñ¼Æ=1
         For i = j - 1 To 1 Step -1
         '¡ô³]¤º¼h­Ë°j°é!±qj·í®æ«e¤@®æ¶}©l¨ì³Ì«e­±¨º¤Ñ
            M0 = Format(Crr(1, i), "mm")
            '¡ô¥OM0¬Oi·í®æªº¤ë¤À¼Æ
            Ti = Crr(x + 1, i)
            '¡ô¥OTi¬O­n§P©w¯à¤£¯à¦Y¤UÅu¥­­Èªº·í®æ
            If Ti <> 0 And Avgd = 1 Then
            '¡ô¦pªG«e¤è®æªº­È¤£¬O0,¥B¥iÅu¥­¤Ñ¼Æ¬O1
               Avgv = Tj
               '¡ô¥i³QÅu¥­ªº¼Æ¶q´N¬Ojªº·í®æ­È
               GoTo 111
               '¡ô¸õ¨ì 111ªº¦ì¸mÄ~Äò°õ¦æ
            End If
            If Ti = 0 And M0 <> M1 And Avgd = 1 Then
            '¡ô¦pªG«e¤è®æ¬O0¥B¥iÅu¥­¤Ñ¼Æµ¥©ó1¥B¤ë¼Æ¤w¸g¤£¤@¼Ë¤F
               Avgv = Tj
               '¡ô¥i³QÅu¥­ªº¼Æ¶q´N¬Ojªº·í®æ­È
            End If
            If (Ti <> 0 And Avgd > 1) Or M0 <> M1 Then
            '¡ô(¦pªG«e¤è®æ¤£¬O0¥B¥iÅu¥­¤Ñ¼Æ¤j©ó1)©Î¤ë¼Æ¤w¸g¤£¤@¼Ë¤F
               GoTo 111
               '¡ô¸õ¨ì 111ªº¦ì¸mÄ~Äò°õ¦æ
            End If
            If Ti = 0 Then
            '¡ô¦pªG«e¤è®æ¬O0
               Avgd = Avgd + 1
               '¡ô¥iÅu¥­¤Ñ¼Æ+1
               Avgv = Round(Tj / Avgd, PP)
               '¡ôÅu¥­­È=¶·Åu¥­­È°£¥H¥iÅu¥­¤Ñ¼Æ¤§«á¥|±Ë¤­¤J¨ú¾ã¼Æ
            End If
         Next i
      End If
111
      If Avgd > 1 And Avgv <> 0 Then
      '¡ô¦pªG¥iÅu¥­¤Ñ¼Æ¤j©ó1 ¥B Åu¥­­È¤£µ¥©ó 0
         Crr(x + 1, j) = Avgv
         '¡ô´N§âÅu¥­­È­Ë¤J¬Û¹ï¦ì¸m
         Avgd = Avgd - 1
         '¡ô¥iÅu¥­¤Ñ¼Æ´N´î1
         '¥iÅu¥­¤Ñ¼Æ¦]¬°«á­±GoTo 111 ´N¥²¶·´î¨ì±ø¥ó¤£¦¨¥ß

         y(j) = y(j) + Avgv
         '¡ô·í¤Ñ¥þ³¡Åu¥­Á`©M­n²Ö¥[
         j = j - 1
         '¡ôj·í®æªº«e¤@¤Ñ³Q¥Î±¼¤F!j´N­n«e¶i¤@®æ
         GoTo 111
         '¡ô¸õ¨ì 111¦ì¸m°õ¦æ
         ElseIf Avgd = 1 And Avgv <> 0 Then
         '¡ô§_«h¦pªG¥iÅu¥­¤Ñ¼Æµ¥©ó1 ¥B Åu¥­­È¤£µ¥©ó 0
            Crr(x + 1, j) = Avgv
            '¡ô´N§âÅu¥­­È­Ë¤J¬Û¹ï¦ì¸m
            Avgd = Avgd - 1
            '¡ô¥iÅu¥­¤Ñ¼Æ´N´î1
            y(j) = y(j) + Avgv
            '¡ô·í¤Ñ¥þ³¡Åu¥­Á`©M­n²Ö¥[
            Avgv = 0
            '¡ôÅu¥­­ÈÂk¹s
      End If
   Next j
Next x
For j = 1 To Sc
'¡ô³]¥¿°j°éÅý·í¤é¦X­p©ñ¤JCrr°}¦C³Ì«á¤@¦C
   Crr(UBound(Crr), j) = y(j)
Next
For i = 2 To UBound(Crr) - 1
'¡ô³]¥¿°j°é§â©Ò¦³Åu¥­»P¤£¯àÅu¥­ªº­q³æ­È¥[°_¨Ó
   For x = 1 To UBound(Crr, 2) - 1
      Ch1 = Ch1 + Crr(i, x)
      '¡ôCh1¥[¨ì³Ì«á´N¬OÅu¥­«áªºÁ`¦X­p
   Next
Next
With Sheets("PP-¥­§¡")
'¡ô¤U­±¬O¦³Ãö¤u§@ªíªºµ{§Ç
   .UsedRange.Offset(1, 0).EntireRow.Delete
   '¡ô§â¤u§@ªí¦³¨Ï¥Îªº¦C©¹¤U°¾²¾¤@¦Cªº½d³ò§R°£
   
   .[2:2].Font.Size = 10
   '¡ô¥O²Ä¤G¦C¦rÅé¤j¤p¬O10
   
   .Range(.Cells(2, 8), .Cells(2, 8 + Cc)).NumberFormatLocal = "m/d;@"
   '¡ô¥O§Y±N­n©ñ¤J¤é´Áªº¨º´X®æªº®æ¦¡¬O ¤ë/¤é
   
   .[A2].Resize(UBound(Brr), Bc) = Brr
   '¡ô¥ý±NBrr°}¦C±qA2¶}©l­Ë¤J
   .[H2].Resize(UBound(Crr), Cc) = Crr
   '¡ô¦A±NCrr°}¦C±qH2¶}©l­Ë¤J
   .UsedRange.Offset(1, 0).EntireRow.Borders.LineStyle = xlContinuous
   '¡ôÅýÀx¦s®æÅã¥Ü®æ½u
   .[A1] = xA(1, 1)
   '¡ô§â "PP"¤u§@ªíªº[A1]­È±a¨ì¦¹ªí[A1]
End With
Sheets("PP-¥­§¡").Activate
'¡ôµe­±¸õ¨ì "PP-¥­§¡" ¤u§@ªí
ActiveWindow.FreezePanes = False
'¡ô§â­áµ²µ¡®æ¨ú®ø
[H3].Activate: ActiveWindow.FreezePanes = True: [A1].Activate
'¡ô±NH3¬°¬É½u!Åý¥ª°¼Äæ¦ì­áµ²!Åý¤W¤è¦C¦ì­áµ²
Set Brr = Nothing
Set Crr = Nothing
Set y = Nothing
End Sub
Sub ¥¿¦¡°õ¦æ_Àˬd()
PP = 0
Call ¾î¦V©¹«eÅu¥­
MsgBox "**»~®t¶q: " & Ch0 - Ch1 & "  **"
End Sub

TOP

¦^´_ 11# Andy2483


    ·PÁÂAndy2483¤j¤£¦ý¨ó§U¦^´_ÁÙ¸Ô²Ó»¡©ú¡A¯u¬O¤Ó¦³¤ß¤F
Adam

TOP

        ÀR«ä¦Û¦b : ®É®É¦n¤ß´N¬O®É®É¦n¤é¡C
ªð¦^¦Cªí ¤W¤@¥DÃD