- 帖子
- 2035
- 主題
- 24
- 精華
- 0
- 積分
- 2031
- 點名
- 0
- 作業系統
- Win7
- 軟體版本
- Office2010
- 閱讀權限
- 100
- 性別
- 男
- 註冊時間
- 2012-3-22
- 最後登錄
- 2024-2-1
|
3#
發表於 2017-1-5 17:10
| 只看該作者
本帖最後由 c_c_lai 於 2017-1-5 20:04 編輯
回復 2# ziv976688 h0 dl3d04d04
參考看看!
因我不懂這遊戲規則,只將你的程式碼略予試寫,不知可否?- Sub Ex()
- Dim startrang%, endrang%, tim!, In1rr As Variant, In2rr As Variant, StrRng$, Ncount$, Number
- Dim RrngA$, Nrange$, CrngA$, RrngB$, CrngB$, i%, j%, y%, num$, Order$, NUMX$
- Dim m1%, sta%
- StrRng = "1" ' InputBox("請輸入DATA!各搜尋比對的起始期數", "輸入期數")
- Nrange = "280" ' InputBox("請輸入DATA!各搜尋比對的迄止(開獎)期數", "輸入期數")
- num = "50" ' InputBox("請輸入效果檔A︰H複製範圍的期距數", "輸入距期數")
- RrngA = "253,268,273" ' InputBox("請輸入各"第一個"比對的"基準期數", "輸入第一個期數")
- CrngA = "1-2" ' InputBox("請輸入各"第一個"比對的7欄取任1~6之欄位數", "輸入欄位數(1~6)")
- RrngB = "249-250,263,268" ' InputBox("請輸入各"第二個"比對的"基準期數", "輸入第二個期數")
- CrngB = "1-2" ' InputBox("請輸入各"第二個"比對的7欄取任1~6之欄位數", "輸入欄位數(1~6))
- Order = "" ' InputBox("請輸入再篩選邏輯條件的起迄序號", "輸入序號(1~99)或不增加(按Enter)")
- Number = "04,12,20-22,30,34,38,42,47" ' InputBox("請輸入各指定的號碼", "輸入號碼(1~49)")
- Ncount = "2-3" ' InputBox("請輸入驗證版的連續次數", "輸入次數(2~10)")
-
- tim = Timer
- [L1:L10] = ""
- NUMX = num
- Application.DisplayAlerts = False
- On Error Resume Next ' 將錯誤處理的方式設為「繼續下一行」。
- Application.ScreenUpdating = False ' 在背景下執行
-
- ' ...............
- In1rr = ToSplit(Nrange, ",")
-
- ' ................
- In2rr = ToSplit(NUMX, ",")
- ' ................
-
- ' .......................
- [L1] = Nrange & "=" & Format((Timer - tim) / 24 / 60 / 60, "hh:mm:ss")
- [L2] = "DATA!各搜尋比對的起始期數=" & StrRng
- [L3] = "A︰H(開獎版)的期距數=" & NUMX
- [L4] = "比對基準期數A=" & RrngA
- [L5] = "欄位數A=" & CrngA
- [L6] = "比對基準期數B=" & RrngB
- [L7] = "欄位數B=" & CrngB
- [L8] = "增加再篩選邏輯條件的序號=" & Order
- [L9] = "各指定同號碼=" & Number
- [L10] = "驗證版的連續次數=" & Ncount
- End Sub
- Function ToSplit(txt As String, sp As String, Optional dash As String = "-") As String()
- Dim FullNameComma As Variant, cts As Integer, nxt As Integer
- Dim lf As Integer, rt As Integer, spl As String
- FullNameComma = Split(txt, sp)
- spl = ""
- For cts = LBound(FullNameComma) To UBound(FullNameComma)
- nxt = InStr(FullNameComma(cts), dash)
- If nxt > 0 Then
- lf = Val(Left(FullNameComma(cts), nxt - 1))
- rt = Val(Mid(FullNameComma(cts), nxt + 1))
- For nxt = lf To rt
- spl = IIf(spl = "", CStr(nxt), spl & sp & CStr(nxt))
- Next
- Else
- spl = IIf(spl = "", FullNameComma(cts), spl & sp & FullNameComma(cts))
- End If
- Next cts
-
- ToSplit = Split(spl, sp)
- End Function
複製代碼 |
|