- 帖子
- 678
- 主題
- 147
- 精華
- 0
- 積分
- 799
- 點名
- 0
- 作業系統
- win 8
- 軟體版本
- MS 2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2016-2-9
- 最後登錄
- 2022-1-20
|
9#
發表於 2017-10-20 20:02
| 只看該作者
本帖最後由 ziv976688 於 2017-10-20 20:10 編輯
回復 1# ziv976688
 2017-1020-Q-1 -.rar (96.21 KB)
原附檔程式碼太長~重新上傳附檔和說明:
If a = INnum(N2 - 1) Then '比對期數的列 '列178
Sheets.Add
ActiveSheet.Name = "Sheet1"
ActiveWindow.Zoom = 75 '縮放
' 複製"Sheet1"內容
[A4].Resize(3, 79).Copy Sheets("Sheet1").Cells(4, 1) '複製DATA=A4:CA6貼上A4
Cells(In1rr(N1 - 1) + 6, 1).Resize(In2rr(numh) - In1rr(N1 - 1) + 1, 1).Copy Sheets("Sheet1").Cells(7, 1) '複製DATA=A&StrRng到A&mthcount期數貼上A7
Cells(In1rr(N1 - 1) + 6, 2).Resize(In2rr(numh) - In1rr(N1 - 1), 7).Copy Sheets("Sheet1").Cells(7, 2) '複製DATA=B&StrRng到H&mthcount-1期數貼上B7
Cells(a.Row + 1, 1).Resize(In2rr(numh) - a.Row + 6, 1).Copy Sheets("Sheet1").Cells(7, 9) '複製DATA=A欄比對期數+1到mthcount期數貼上I7
Cells(a.Row + 1, 2).Resize(In2rr(numh) - a.Row + 5, 7).Copy Sheets("Sheet1").Cells(7, 10) '複製DATA=B:H欄比對期數+1到mthcount期數貼上J7
Cells(In1rr(N1 - 1) + 6, 1).Resize(a.Row - In1rr(N1 - 1) - 5, 8).Copy Sheets("Sheet1").Cells(In2rr(numh) - a.Row + 13, 9) '複製DATA=A:H欄起始期數到比對期數貼上I & mthcount-比對期數+13
a.Copy Sheets("Sheet1").Cells(In2rr(numh) - In1rr(N1 - 1) + 7, a.Column) '複製搜尋值貼上mthcount期數B:H同欄
a.Copy Sheets("Sheet1").Cells(In2rr(numh) - a.Row + 12, a.Column + 8) '複製搜尋值貼mthcount-比對期數+12列的J:P同欄
Sheets("Sheet1").Range("AN5") = Cells(a.Row, 1) '指定的各比對期數
' 複製&字體標示
Sheets("Sheet1").Cells(7, 1).Resize(In2rr(numh) - In1rr(N1 - 1) + 1, 8).Copy Sheets("Sheet1").Cells(7, 25) '複製A:H貼上Y
Sheets("Sheet1").Cells(7, 9).Resize(In2rr(numh) - In1rr(N1 - 1) + 1, 8).Copy Sheets("Sheet1").Cells(7, 17) '複製I:P貼上Q
Sheets("Sheet1").Cells(7, 9).Resize(In2rr(numh) - In1rr(N1 - 1) + 1, 1).Font.ColorIndex = 9 'I欄字體標示
Sheets("Sheet1").Cells(7, 17).Resize(In2rr(numh) - In1rr(N1 - 1) + 1, 1).Font.ColorIndex = 10 'Q欄字體標示
Sheets("Sheet1").Cells(7, 1).Resize(In2rr(numh) - In1rr(N1 - 1) + 1, 32).Copy Sheets("Sheet1").Cells(7, 47) '複製A:P貼上AU
Sheets("Sheet1").Range("B8").Select
ActiveWindow.FreezePanes = True '凍結視窗
Sheets("Sheet1").Move
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs MyPath & "\49AC_" & INnum(N2 - 1) & "_" & Inlog(LOGN - 1) & "_" & In2rr(numh) & "-" & In1rr(N1 - 1) & "-" & Sheets("Sheet1").Range("AN5") & ".xls"
ActiveWindow.Close
'GoTo l01
'機率表......................................................................................... '列207
Else
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
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
'....................................................................... '列240
'101:
End If '列244
...................
...................
...................
End Sub '列255
最主要是列207~列240(機率表)的部分:因為尚有疑問待決，所以想先暫不執行。
請問:
不執行TEST(1020)-B列207:240的程式碼，其程式碼應如何再編寫~
才可令程式碼由列204直接跳到列244(End If)繼續執行(即其執行效果=TEST(1020)-A)?
謝謝! |
|
