Option Explicit
Sub 隨機取號()
Dim Z
Set Z = CreateObject("Scripting.Dictionary")
[C2:G2].UnMerge
Do Until Z.Count = 5
Z(Int(Rnd() * 10 ^ 5) Mod 39 + 1) = ""
Loop
[C2].Resize(, 5) = Z.KEYS(): [C2:G2].Activate
End Sub作者: jdg188 時間: 2024-1-24 09:48
Sub 開出次數統計3()
Dim Crr(1 To 6, 1 To 100), i%, j%, V%, xR As Range, D As Date, y%, ii%, S&, Z, T$, TT, M%
If UBound(Brr) < 100 Then Exit Sub
Set Z = CreateObject("Scripting.Dictionary")
Worksheets.Add after:=Worksheets(Sheets.Count): ActiveSheet.Name = "開出次數3"
Cells.Font.Name = "微軟正黑體": Cells.HorizontalAlignment = xlCenter: Set xR = [C1]
For i = UBound(Brr) To 100 Step -1
With xR.Resize(6, UBound(Crr, 2))
Range(.Rows(1), .Rows(1).Offset(, -2)).Borders.LineStyle = xlContinuous
Range(.Rows(1), .Rows(1).Offset(, -2)).Interior.ColorIndex = 19
For ii = 7 To 10: Range(.Cells, .Offset(, -2)).Borders(ii).Weight = 4: Next
Intersect(.Columns(1), .Columns(1).Offset(1)).Interior.ColorIndex = i Mod 15 + 33
End With
D = Brr(i, 2) + 1: S = Brr(i, 1) + 1
For j = 1 To 6
TT = T & "/": T = ""
For V = 1 To 100
Crr(1, V) = V - 1
For y = 2 To 6
If V = 1 Then T = T & "/" & Brr(i - V + 1, y + 1)
If Z(Val(Brr(i - V + 1, y + 1))) = 0 Then
Crr(y, V) = Brr(i - V + 1, y + 1)
Z(Val(Brr(i - V + 1, y + 1))) = 1
If InStr(TT, "/" & Val(Brr(i - V + 1, y + 1)) & "/") Then
xR(y, V).Interior.ColorIndex = 5: xR(y, V).Font.ColorIndex = 2
If M < V Then M = V
End If
End If
Next
Next
Next
With xR.Resize(6, UBound(Crr, 2)): .Value = Crr: xR(1, -1) = "期數 (日期)": End With
xR(2, -1).Resize(5).Merge: xR(2, -1) = S & " (" & D & ")": xR(2, -1).Font.Bold = True
xR(2, -1).Resize(5).Interior.ColorIndex = IIf(i = UBound(Brr), 38, 40)
Set xR = xR(7, 1): Z.RemoveAll: Erase Crr
Next
ActiveSheet.UsedRange.EntireColumn.AutoFit: [B:B].ColumnWidth = 2
ActiveSheet.UsedRange.Offset(, M + 2).EntireColumn.Delete
ActiveSheet.UsedRange.Borders(10).Weight = 4: ActiveWindow.Zoom = 85
ActiveSheet.UsedRange.Offset([C65536].End(3).Row).EntireRow.Delete
End Sub作者: jdg188 時間: 2024-1-26 08:19
[/quote]