產生檔案及工作表的語法

ziv976688

煩請各位高手指教!謝謝!
根據各InputBox填入的數字，產生各檔案及工作表
檔案名稱= FTC_" & UpRng & "_"& StrRng & "-" & mthcount & "期.xls"

各檔案內的工作表
工作表名稱= mthcount & "-" & mthcount - i
(For i = 1 To UpRng︰ Next)

最後在右邊再續增加一個名稱="機率表"的工作表

工作表的內容︰
A1︰H1=DATA!標題(期數 一 二 三 四 五 六 特)；I1︰P1= DATA!標題
I2︰P& mthcount- StrRng +2= DATA!A&StrRng+1︰DATA!H& mthcount +1

"機率表"工作表內容
A1︰F1=
預測號碼        出現期數        出現次數        預測號碼個數        中獎號碼        中獎比率

EX︰
    StrRng = "2,10"
    Nrange = "100,200"
    UpRng = "4,8"

產生如附件
製作.rar (72.27 KB)

下載次數: 10

2016-2-9 21:16

ziv976688

補充:
原3段InputBox程式碼示我在網路上擷取的，
但不知要如何套用和加寫才能完成如範例的結果?
有請各位高手幫忙!謝謝!

註:因怕附件太多，所以200期的效果檔省略未附。

ziv976688

趁年假在網路上搜尋多天，已自行兜湊完成。謝謝!

starry1314

回復 3# ziv976688

請問可分享完成的範例做參考嗎?

Thanks

ziv976688

回復 3# ziv976688
不好意思，因本題的需求只是完成J:P欄的半成品，還談不上有什麼參考的價值
等我完成A:P欄的全部基本架構後，再貼出分享為何^^

ziv976688

回復 4# starry1314
FTC_1-Ans.rar (49.74 KB)

下載次數: 6

2016-2-15 13:41

粗胚已完成，其餘儲存格格式,欄寬等細部程式碼，請自行斟添。

starry1314

回復 6# ziv976688
感謝分享囉～

c_c_lai

回復 6# ziv976688
回復 7# starry1314

下載 (45.7 KB)

2016-2-18 09:32

Dic.rar (71.65 KB)

下載次數: 0

2016-2-18 09:32

ziv976688

回復 8# c_c_lai
c_c_lai大大:您好!
雖然無法下載您上傳的範例檔案，無法學習您的解題公式；但還是謝謝您的回應

c_c_lai

回復 9# ziv976688

1. Sub Ex()
   
2.     Dim dic As Object, rng As Range, fld As Range, txt As String
   
3.    
   
4.     Set rng = Range("B2:H" & [H65536].End(xlUp).Row)
   
5.     Set dic = CreateObject("scripting.dictionary")
   
6.    
   
7.     [K:O].Clear
   
8.     For Each fld In rng
   
9.         txt = fld.Value
   
10.         If dic.exists(txt) = False Then
    
11.             dic(txt) = 1
    
12.         Else
    
13.             dic(txt) = dic(txt) + 1
    
14.         End If
    
15.     Next
    
16.    
    
17.     [K1] = "  由小而大依序排列"
    
18.     [K2].Resize(UBound(dic.KEYS) + 1) = Application.Transpose(dic.KEYS)                '  索引值就是 Keys
    
19.     [L2].Resize(UBound(dic.KEYS) + 1) = Application.Transpose(dic.Items)               '  資料內容就是 Items
    
20. 
    
21.     With [K2].Resize(UBound(dic.KEYS) + 1, 2)        '  Range("K2:L" & [L2].End(xlDown).Row)
    
22.         .Cells.Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo     ' xlDescending
    
23.     End With
    
24.    
    
25.     Range("K2:L" & [L65536].End(xlUp).Row).Copy [N2]
    
26.    
    
27.     [N1] = "依出現機率數據排列"
    
28.     With [N2].Resize(UBound(dic.KEYS) + 1, 2)        '  Range("N2:O" & [O2].End(xlDown).Row)
    
29.         .Cells.Sort Key1:=.Cells(2), Order1:=xlDescending, Header:=xlNo     ' xlAscending
    
30.     End With
    
31. End Sub

複製代碼