- ©«¤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
|
¦^´_ 3# hcm19522
ÁÂÁ«e½ú
«á¾ÇÂǦ¹©«¾Ç²ß¨ì«Ü¦hª¾ÃÑ»P¸gÅç,¥H¤U¬O¼ÒÀÀ¨C¤Ñ²Îp»P¹Ïªí
½Ð¦U¦ì«e½ú«ü¾É
°õ¦æ«e:
¥þ³¡:
³Ì«á5µ§:
³Ì«á10µ§:
Option Explicit
Dim x&
Sub «½Æ°õ¦æ_»s§@½d¨Ò()
For x = -10 To 0
Call EÄæ·s¼W¶Ã¼Æ¥¿tÈ_¤é´Á
Next
End Sub
Sub EÄæ·s¼W¶Ã¼Æ¥¿tÈ_¤é´Á() '³o¬O²£¥Í¼ÒÀÀ½d¨Ò¥Îªº
Dim Arr As Range, Brr As Range
Set Brr = [E65536].End(3).Item(2).Resize(Rnd() * 100 \ 5 + 10)
Set Arr = Brr.Offset(, -4)
With Brr
.Formula = "=IF(RAND()>.5,INT(RAND()*100),INT(RAND()*-100))"
.Value = .Value
End With
With Arr
.Formula = "=TODAY()+" & x
.Value = .Value
End With
[A1] = IIf([A1] = "", "¤é´Á", [A1])
[E1] = IIf([E1] = "", "¼ÆÈ", [E1])
End Sub
Sub ¦bFÄæÅã¥Ü_§PÂ_EÄ楿0tµ²ªG()
Dim Brr As Range
Set Brr = Range([E2], [E65536].End(3)).Offset(, 1)
With Brr
.Formula = "=IF(E2=0,0,IF(E2>0,""¥¿¼Æ"",""t¼Æ""))"
End With
[F1] = IIf([F1] = "", "§P©w", [F1])
Call áµ²µ¡®æ_²Ä¤@¦C_µøµ¡Åã¥Ü¦b³Ì«á10µ§¸ê®Æ
End Sub
Sub áµ²µ¡®æ_²Ä¤@¦C_µøµ¡Åã¥Ü¦b³Ì«á10µ§¸ê®Æ()
With ActiveWindow
.FreezePanes = False
.ScrollRow = 1
.SplitRow = 1
.FreezePanes = True
.ScrollRow = [E65536].End(3).Row - 9
End With
[A1].Activate
End Sub
Sub «È¤á¥X³fª÷ÃB_²Îp¹Ïªí()
Application.ScreenUpdating = False
Call ¦bFÄæÅã¥Ü_§PÂ_EÄ楿0tµ²ªG
Dim Yrr, i&, Y, Z, V, d, n, R, d5, x, k0, k1, M
Dim Dats As Date, Datn As Date, Arr, Brr, Crr
Set Y = CreateObject("Scripting.Dictionary")
Set Z = CreateObject("Scripting.Dictionary")
Set V = CreateObject("Scripting.Dictionary")
Set Yrr = Range([A1], [E65536].End(3))
R = [A1].End(xlDown).Row
For i = R To 2 Step -1
Dats = Yrr(2, 1)
Datn = Yrr(R, 1)
If Yrr(i, 1) <> "" Then
d = Yrr(i, 1)
d5 = Yrr(i, 5)
If d5 > 0 Then
Y(d & "|¥¿¼Æ") = Y(d & "|¥¿¼Æ") + 1
If Z(d) < 5 Then
Z(d & "|¥¿¼Æ") = Z(d & "|¥¿¼Æ") + 1
Z(d) = Z(d) + 1
End If
If V(d) < 10 Then
V(d & "|¥¿¼Æ") = V(d & "|¥¿¼Æ") + 1
V(d) = V(d) + 1
End If
ElseIf d5 < 0 Then
Y(d & "|t¼Æ") = Y(d & "|t¼Æ") + 1
If Z(d) < 5 Then
Z(d & "|t¼Æ") = Z(d & "|t¼Æ") + 1
Z(d) = Z(d) + 1
End If
If V(d) < 10 Then
V(d & "|t¼Æ") = V(d & "|t¼Æ") + 1
V(d) = V(d) + 1
End If
Else
Y(d & "|¹s") = Y(d & "|¹s") + 1
If Z(d) < 5 Then
Z(d & "|¹s") = Z(d & "|¹s") + 1
Z(d) = Z(d) + 1
End If
If V(d) < 10 Then
V(d & "|¹s") = V(d & "|¹s") + 1
V(d) = V(d) + 1
End If
End If
End If
Next
ReDim Arr(1 To Y.Count, 1 To 4)
For Each x In Y.KEYS
If InStr(x, "|") Then
k0 = Split(x, "|")(0)
k1 = Split(x, "|")(1)
If M <> k0 Then
n = n + 1
M = k0
Arr(n, 1) = k0
End If
If k1 = "¥¿¼Æ" Then Arr(n, 2) = Y(x)
If k1 = "t¼Æ" Then Arr(n, 3) = Y(x)
If k1 = "¹s" Then Arr(n, 4) = Y(x)
End If
Next
Workbooks.Add
[A1].Resize(, 4) = [{"¤é´Á","¥¿¼Æ","t¼Æ","¹s"}]
[A2].Resize(UBound(Arr), 4) = Arr
Cells.Columns.AutoFit
[E1] = "¨C¤é¥þ³¡¥¿t¼Æ¼Æ¶q²Îp! °Ï¶¡(" & Dats & "~" & Datn & ")"
[E1].Font.Size = 18
[E1].Font.Bold = True
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Range([A1], Cells([A65536].End(xlUp).Row, "D"))
With ActiveSheet.Shapes("¹Ïªí 1")
.ScaleWidth 2, msoFalse, msoScaleFromBottomRight
.ScaleWidth 1, msoFalse, msoScaleFromTopLeft
.ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
.IncrementLeft -500
.IncrementTop -500
.IncrementTop 20
ActiveChart.SeriesCollection(1).ApplyDataLabels
ActiveChart.SeriesCollection(2).ApplyDataLabels
ActiveChart.SeriesCollection(3).ApplyDataLabels
End With
[E1].Activate
ActiveSheet.Name = "¨C¤é¥þ³¡¥¿t¼Æ"
'------------------------------------------------------
Worksheets.Add.Name = "¨C¤é³Ì«á5µ§"
ReDim Arr(1 To Z.Count, 1 To 4)
n = 0
For Each x In Z.KEYS
If InStr(x, "|") Then
k0 = Split(x, "|")(0)
k1 = Split(x, "|")(1)
If M <> k0 Then
n = n + 1
M = k0
Arr(n, 1) = k0
End If
If k1 = "¥¿¼Æ" Then Arr(n, 2) = Z(x)
If k1 = "t¼Æ" Then Arr(n, 3) = Z(x)
If k1 = "¹s" Then Arr(n, 4) = Z(x)
End If
Next
[A1].Resize(, 4) = [{"¤é´Á","¥¿¼Æ","t¼Æ","¹s"}]
[A2].Resize(UBound(Arr), 4) = Arr
Cells.Columns.AutoFit
[E1] = "¨C¤é³Ì«á5µ§¥¿t¼Æ¼Æ¶q²Îp! °Ï¶¡(" & Dats & "~" & Datn & ")"
[E1].Font.Size = 18
[E1].Font.Bold = True
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Range([A1], Cells([A65536].End(xlUp).Row, "D"))
With ActiveSheet.Shapes("¹Ïªí 1")
.ScaleWidth 2, msoFalse, msoScaleFromBottomRight
.ScaleWidth 1, msoFalse, msoScaleFromTopLeft
.ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
.IncrementLeft -500
.IncrementTop -500
.IncrementTop 20
ActiveChart.SeriesCollection(1).ApplyDataLabels
ActiveChart.SeriesCollection(2).ApplyDataLabels
ActiveChart.SeriesCollection(3).ApplyDataLabels
End With
[E1].Activate
'------------------------------------------------------
Worksheets.Add.Name = "¨C¤é³Ì«á10µ§"
ReDim Arr(1 To V.Count, 1 To 4)
n = 0
For Each x In V.KEYS
If InStr(x, "|") Then
k0 = Split(x, "|")(0)
k1 = Split(x, "|")(1)
If M <> k0 Then
n = n + 1
M = k0
Arr(n, 1) = k0
End If
If k1 = "¥¿¼Æ" Then Arr(n, 2) = V(x)
If k1 = "t¼Æ" Then Arr(n, 3) = V(x)
If k1 = "¹s" Then Arr(n, 4) = V(x)
End If
Next
[A1].Resize(, 4) = [{"¤é´Á","¥¿¼Æ","t¼Æ","¹s"}]
[A2].Resize(UBound(Arr), 4) = Arr
Cells.Columns.AutoFit
[E1] = "¨C¤é³Ì«á10µ§¥¿t¼Æ¼Æ¶q²Îp! °Ï¶¡(" & Dats & "~" & Datn & ")"
[E1].Font.Size = 18
[E1].Font.Bold = True
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Range([A1], Cells([A65536].End(xlUp).Row, "D"))
With ActiveSheet.Shapes("¹Ïªí 1")
.ScaleWidth 2, msoFalse, msoScaleFromBottomRight
.ScaleWidth 1, msoFalse, msoScaleFromTopLeft
.ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
.IncrementLeft -500
.IncrementTop -500
.IncrementTop 20
ActiveChart.SeriesCollection(1).ApplyDataLabels
ActiveChart.SeriesCollection(2).ApplyDataLabels
ActiveChart.SeriesCollection(3).ApplyDataLabels
End With
[E1].Activate
Set Y = Nothing
Set Z = Nothing
Set V = Nothing
Set Yrr = Nothing
End Sub |
|