返回列表 上一主題 發帖

產生檔案及工作表的語法

產生檔案及工作表的語法

本帖最後由 ziv976688 於 2016-2-9 21:16 編輯

煩請各位高手指教!謝謝!
根據各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)

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

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

TOP

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

TOP

回復 3# ziv976688

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

Thanks

TOP

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

TOP

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

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

TOP

回復 6# ziv976688
感謝分享囉∼
做該做的事是智慧,做不該做的事是愚癡。
程式分享 搜尋 partylin_程式學習營
https://partylin.azurewebsites.net/

TOP

回復 6# ziv976688
回復 7# starry1314
E.png
2016-2-18 09:32

Dic.rar (71.65 KB)
E.png

Dic.rar (71.65 KB)

TOP

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

TOP

回復 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.     With [K2].Resize(UBound(dic.KEYS) + 1, 2)        '  Range("K2:L" & [L2].End(xlDown).Row)
  21.         .Cells.Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlNo     ' xlDescending
  22.     End With
  23.    
  24.     Range("K2:L" & [L65536].End(xlUp).Row).Copy [N2]
  25.    
  26.     [N1] = "依出現機率數據排列"
  27.     With [N2].Resize(UBound(dic.KEYS) + 1, 2)        '  Range("N2:O" & [O2].End(xlDown).Row)
  28.         .Cells.Sort Key1:=.Cells(2), Order1:=xlDescending, Header:=xlNo     ' xlAscending
  29.     End With
  30. End Sub
複製代碼

TOP

        靜思自在 : 為自己找藉口的人永遠不會進步。
返回列表 上一主題