- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
¦^´_ 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§À°Ï¶¡ªº¤Ñ¼Æ!¤@©wn¥[1¤~¯à¥]§t³Ì«á¤@¤Ñ
Sr = UBound(Brr) - 2
'¡ô¥OSr¬OBrrªº¦C¼Æ´î±¼2¦C
Ch0 = Brr(UBound(Brr, 1), UBound(Brr, 2))
'¡ô¥OCh0¬O³Ì¥k¤U¨¤ªºÈ(Á`¦Xp)
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°¼ªº¤pp©ñ¤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Åý¦Xp¥[¤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¬On§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¬On§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¥Á`©Mn²Ö¥[
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¬On§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¥Á`©Mn²Ö¥[
j = j - 1
'¡ôj·í®æªº«e¤@¤Ñ³Q¥Î±¼¤F!j´Nn«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¥Á`©Mn²Ö¥[
Avgv = 0
'¡ôÅu¥ÈÂk¹s
End If
Next j
Next x
For j = 1 To Sc
'¡ô³]¥¿°j°éÅý·í¤é¦Xp©ñ¤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¥«áªºÁ`¦Xp
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±Nn©ñ¤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 |
|