Option Explicit
Sub E欄新增亂數正負值() '這是產生模擬範例用的
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 在F欄顯示_判斷E欄正0負結果()
Dim Brr As Range
Set Brr = Range([E2], [E65536].End(3)).Offset(, 1)
With Brr
.Formula = "=IF(E2=0,0,IF(E2>0,""正值"",""負值""))"
End With
[F1] = IIf([F1] = "", "判定", [F1])
End Sub
Sub 凍結窗格_第一列_視窗顯示在最後10筆資料()
With ActiveWindow
.FreezePanes = False
.ScrollRow = 1
.SplitRow = 1
.FreezePanes = True
.ScrollRow = [E65536].End(3).Row - 9
End With '
End Sub作者: hcm19522 時間: 2022-12-29 11:23
Option Explicit
Dim x&
Sub 重複執行_製作範例()
For x = -10 To 0
Call E欄新增亂數正負值_日期
Next
End Sub
Sub E欄新增亂數正負值_日期() '這是產生模擬範例用的
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 在F欄顯示_判斷E欄正0負結果()
Dim Brr As Range
Set Brr = Range([E2], [E65536].End(3)).Offset(, 1)
With Brr
.Formula = "=IF(E2=0,0,IF(E2>0,""正數"",""負數""))"
End With
[F1] = IIf([F1] = "", "判定", [F1])
Call 凍結窗格_第一列_視窗顯示在最後10筆資料
End Sub
Sub 凍結窗格_第一列_視窗顯示在最後10筆資料()
With ActiveWindow
.FreezePanes = False
.ScrollRow = 1
.SplitRow = 1
.FreezePanes = True
.ScrollRow = [E65536].End(3).Row - 9
End With
[A1].Activate
End Sub
Sub 客戶出貨金額_統計圖表()
Application.ScreenUpdating = False
Call 在F欄顯示_判斷E欄正0負結果
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 & "|負數") = 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
Else
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
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 = "負數" Then Arr(n, 3) = Y(x)
If k1 = "零" Then Arr(n, 4) = Y(x)
End If
Next
Workbooks.Add
[A1].Resize(, 4) = [{"日期","正數","負數","零"}]
[A2].Resize(UBound(Arr), 4) = Arr
Cells.Columns.AutoFit
[E1] = "每日全部正負數數量統計! 區間(" & 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 = "每日全部正負數"
'------------------------------------------------------
Worksheets.Add.Name = "每日最後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 = "負數" Then Arr(n, 3) = Z(x)
If k1 = "零" Then Arr(n, 4) = Z(x)
End If
Next
[A1].Resize(, 4) = [{"日期","正數","負數","零"}]
[A2].Resize(UBound(Arr), 4) = Arr
Cells.Columns.AutoFit
[E1] = "每日最後5筆正負數數量統計! 區間(" & 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 = "每日最後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 = "負數" Then Arr(n, 3) = V(x)
If k1 = "零" Then Arr(n, 4) = V(x)
End If
Next
[A1].Resize(, 4) = [{"日期","正數","負數","零"}]
[A2].Resize(UBound(Arr), 4) = Arr
Cells.Columns.AutoFit
[E1] = "每日最後10筆正負數數量統計! 區間(" & 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
