- 帖子
- 678
- 主題
- 147
- 精華
- 0
- 積分
- 799
- 點名
- 0
- 作業系統
- win 8
- 軟體版本
- MS 2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2016-2-9
- 最後登錄
- 2022-1-20
|
14#
發表於 2017-10-21 18:55
| 只看該作者
本帖最後由 ziv976688 於 2017-10-21 19:10 編輯
回復 12# naruto018 - '機率表...........
- Else
- GoTo 101
- Sheets.Add
- ActiveSheet.Name = "機率表"
- Sheets(1).Cells.RowHeight = 20 '列高
- ActiveWindow.Zoom = 75 '縮放
- Sheets(1).Range("B2").Select
- ActiveWindow.FreezePanes = True
- With Sheets(1).[A1:F50]
- .HorizontalAlignment = xlCenter
- .Font.FontStyle = "粗體"
- .Font.Size = 14
- End With
- Sheets(1).[A1:F50].Font.Name = "Arial"
- Sheets(1).[a1] = "推測數字"
- Sheets(1).[A1:A50].Font.ColorIndex = 7
- Sheets(1).[A1:A50].NumberFormatLocal = "00"
- Sheets(1).[B1] = "次數"
- Sheets(1).[B1:B50].Font.ColorIndex = 11
- Sheets(1).[C1] = "中獎數字"
- Sheets(1).[C1:C8].Font.ColorIndex = 3
- Sheets(1).[C1:C8].NumberFormatLocal = "00"
- Sheets(1).[D1] = "中獎機率"
- Sheets(1).[D2] = "=Count(C2:C8)/Count(A2:A50)"
- Sheets(1).[D1:D2].Font.ColorIndex = 3
- Sheets(1).[D2].NumberFormatLocal = "0.0%"
- Sheets(1).Range("D2").Borders.LineStyle = xlContinuous
- n = 1: m = 1: o = 1
- For i = 1 To 49
- If Msrr(i) > 0 Then
- n = n + 1
- Sheets(1).Cells(n, "A") = i
- Sheets(1).Cells(n, "B") = Msrr(i)
- If Urr(i) > 0 Then Sheets(1).Cells(n, "A").Interior.ColorIndex = 4
- End If
- If Urr(i) > 0 Then
- m = m + 1
- Sheets(1).Cells(m, "C") = i
- End If
- Next
- If Sheets(2).Range("H" & In2rr(numh) + 6) <> "" Then
- 'For Each a In Sheets(1).Range("C2:C8")
- If a = "" Then Exit For
- If Application.CountIf(Sheets(2).Range("H" & In2rr(numh) + 6), a) Then: a.Interior.ColorIndex = 8
- 'Next
- End If
- With Sheets(1).Range("C1:C" & m)
- .Borders.LineStyle = xlContinuous
- End With
- With Sheets(1).Range("A1:B" & n)
- .Borders.LineStyle = xlContinuous
- End With
- With Sheets(1) '雙排序
- .Columns("A:B").Sort Key1:=.[B2], Order1:=xlDescending, Key2:=.[a2], Order2:=xlAscending, Header:=xlGuess
- End With
-
- Sheets(1).Columns("A:E").EntireColumn.AutoFit '自動欄寬
- Erase Msrr, Urr '清除機率表記錄
- Sheets("機率表").Move
- ActiveWorkbook.SaveAs mypath1 & "\49AC機_" & Numberx & "_" & Inlog(LOGN - 1) & "_" & In2rr(numh) & "-" & In1rr(N1 - 1) & ".xls"
- ActiveWindow.Close
- '.......................................................................
-
- 101:
在Else(列208)下方插入GoTo 101(列209),在列271插入101:測試=>會停在列249 For Each a In Sheets(1).Range("C2:C8")
表示列210~列268的程式碼還是有被執行。
將列249和列252 Next 點綠不執行=>就OK的
但事實上列210~列268的程式碼還是有被執行。
PS:代碼列2=範例檔列208；代碼列65=範例檔列279
範例檔:
 TEST(1021).rar (50.36 KB)
|
|
