½Ð°ÝExcel ¦Û°Ê§PÂ_¥¿­t¼Æ¼Æ¶q

joefox0725

½Ð°Ý¦U¦ìExcel «e½ú, EÀx¦s®æ¦³¸ê®Æ¨C¤Ñ¤£Â_ªº·s¼W­n§PÂ_¥¿¼Æ»P­t¼Æªº¼Æ¶q ¡A¸ò³Ì«á10µ§»P5µ§ªº¥¿­t¼Æ¼Æ¶q ,½Ð°Ý­n¦p¦ó¨Ï¥Î  ÁÂÁ¤j®a

Andy2483

¦^´_ 3# hcm19522


    ÁÂÁ«e½ú
«á¾ÇÂǦ¹©«¾Ç²ß¨ì«Ü¦hª¾ÃÑ»P¸gÅç,¥H¤U¬O¼ÒÀÀ¨C¤Ñ²Î­p»P¹Ïªí
½Ð¦U¦ì«e½ú«ü¾É
°õ¦æ«e:

¤U¸ü (106.51 KB)

2022-12-30 14:17

¥þ³¡:

¤U¸ü (103.14 KB)

2022-12-30 14:17

³Ì«á5µ§:

¤U¸ü (91.76 KB)

2022-12-30 14:17

³Ì«á10µ§:

¤U¸ü (105.08 KB)

2022-12-30 14:18

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Ä楿0­tµ²ª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Ä楿0­tµ²ª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

hcm19522

https://blog.xuite.net/hcm19522/twblog/590672242

Andy2483

¦^´_ 1# joefox0725


    ÁÂÁ«e½úµoªí¦¹¥DÃD
«á¾ÇÂǦ¹©«½m²ß»Ý¦hµ{¦¡½X,½Ð¸Õ¸Õ¬Ý¬O§_²Å¦X«e½ú»Ý¨D±¡¹Ò

EÄæ·s¼W¶Ã¼Æ¥¿­t­È:

¤U¸ü (95.81 KB)

2022-12-29 08:44

¦bFÄæÅã¥Ü_§PÂ_EÄ楿0­tµ²ªG:

¤U¸ü (102.13 KB)

2022-12-29 08:45

­áµ²µ¡®æ_²Ä¤@¦C_µøµ¡Åã¥Ü¦b³Ì«á10µ§¸ê®Æ:

¤U¸ü (92.4 KB)

2022-12-29 08:45

¦bVBA¸Ì©ñ¤J¥H¤Uµ{¦¡½X:

Option Explicit
Sub EÄæ·s¼W¶Ã¼Æ¥¿­t­È() '³o¬O²£¥Í¼ÒÀÀ½d¨Ò¥Îªº
Dim Brr As Range
Set Brr = [E65536].End(3).Item(2).Resize(10)
With Brr
   .Formula = "=IF(RAND()>.5,INT(RAND()*100),INT(RAND()*-100))"
   .Value = .Value
End With
[E1] = IIf([E1] = "", "¼Æ­È", [E1])
End Sub

Sub ¦bFÄæÅã¥Ü_§PÂ_EÄ楿0­tµ²ª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])
End Sub

Sub ­áµ²µ¡®æ_²Ä¤@¦C_µøµ¡Åã¥Ü¦b³Ì«á10µ§¸ê®Æ()
With ActiveWindow
   .FreezePanes = False
   .ScrollRow = 1
   .SplitRow = 1
   .FreezePanes = True
   .ScrollRow = [E65536].End(3).Row - 9
End With '
End Sub