12
返回列表 上一主題 發帖

[發問] 如何設立可指定計算期數範圍的InputBox？

Airman

帖子
315 
主題
51 
精華
0 
積分
367 
點名
0  
作業系統
win7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
註冊時間
2015-9-29 
最後登錄
2021-10-12 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2018-6-10 00:48 | 只看該作者

[發問] 如何設立可指定計算期數範圍的InputBox？

本帖最後由 Airman 於 2018-6-10 00:59 編輯

如有重複題之慮~請刪除前題。謝謝!

測試檔 :
2018-0610-Q-1 -.rar (66.23 KB)
主檔DATA︰
目前列103程式碼為Qdown = .[R6].End(xlDown).Row
則只將R欄最後期數的當列Q : S資料貼上T4 : T6；以供T3及後續的T7公式計算。

假設列103程式碼為Qdown = .[R6].End(xlDown).Row - 1
則只將R欄最後倒數第二個期數的當列Q : S資料貼上T4 : T6；以供T3及後續的T7公式計算。

假設列103程式碼為Qdown = .[R6].End(xlDown).Row - 2
則只將R欄最後倒數第三個期數的當列Q : S資料貼上T4 : T6；以供T3及後續的T7公式計算。

其餘.....以此類推。

需求︰
想以增加一個Upcount(名稱解題者可擇宜制定)的InputBox，藉其輸入的數字(1~99)，
來指定T4 : T6(含)及其往右各欄要貼上R欄最後的N個期數之各當列的Q : S資料~
EX1︰當InputBox輸入1時，則T4 : T6貼上R欄最後一個期數當列的Q : S資料~
      即等同列103程式碼為Qdown = .[R6].End(xlDown).Row的效果。

EX2︰當InputBox輸入2時，則T4 : T6貼上R欄最後倒數第二個期數當列的Q : S資料及
      U4 : U6貼上R欄最後一個期數當列的Q : S資料~
      即等同列103程式碼為Qdown = .[R6].End(xlDown).Row - 1 & .[R6].End(xlDown).Row的效果。

EX3︰當InputBox輸入3時，則T4 : T6貼上R欄最後倒數第三個期數當列的Q : S資料及
      U4 : U6貼上R欄最後倒數第二個期數當列的Q : S資料及
      V4 : V6貼上R欄最後一個期數當列的Q : S資料~
      即等同列103程式碼為Qdown = .[R6].End(xlDown).Row - 2 & .[R6].End(xlDown).Row - 1 &
      .[R6].End(xlDown).Row的效果。

其餘.....以此類推。


請問 :
Upcount的 InputBox要怎麼設立?
列103的程式碼要如何再撰寫?

以上 敬請各位VBA高手幫忙和賜教! 謝謝!
收藏 分享

Airman

帖子
315 
主題
51 
精華
0 
積分
367 
點名
0  
作業系統
win7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
註冊時間
2015-9-29 
最後登錄
2021-10-12 
13#
發表於 2018-6-25 10:47 | 只看該作者
回復 12# GBKEE
超版大:您好!
謝謝您的耐心註解~2個需求一併解決了。
再次感謝您的費神指導~感恩^^

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
12#
發表於 2018-6-25 07:40 | 只看該作者
本帖最後由 GBKEE 於 2018-6-25 15:08 編輯

回復 11# Airman
  1. Option Explicit
  2. Private Sub CommandButton1_Click()
  3.     Dim UpRow As Variant, E As Variant, i As Integer, Msg As String
  4.     'NUM = "10" ' InputBox("請選擇公式的起迄序號", "序號10-99")
  5.     'Nrange = "200" ' InputBox("請輸入運算的起迄期數", "輸入期數")
  6.     UpRow = InputBox("請選擇S欄最後n個值", "輸入1個-239個", "5,8,9")
  7.     Msg = "選擇S欄最後n個值,格式 數值 有誤"
  8.     'Ttim = Timer
  9.     '[B2] = ""
  10.     '[B3] = ""
  11.     '[F2] = ""
  12.     'numx = NUM
  13.     If InStr(UpRow, "-") Then
  14.         For Each E In Split(UpRow, "-")
  15.             If Not IsNumeric(E) Or i > E Then MsgBox Msg: End  '檢查是否為數字或小於上一個數字
  16.             i = E
  17.         Next
  18.         E = Split(UpRow, "-")(0)   '第一個數字
  19.         ReDim UpRow(E To Split(UpRow, "-")(UBound(Split(UpRow, "-")))) '重置陣列數的大小
  20.         'ReDim 陳述式 在程序層次中用來重新配置動態陣列變數的儲存空間。
  21.         'Split 函數 傳回一個陳列索引從零開始的一維陣列，它包含指定數目的子字串。
  22.         'UBound 函數 傳回 Long值，表示指定陣列某維最大可使用的陣列索引。
  23.         UpRow(E) = E
  24.         For i = UpRow(E) + 1 To UBound(UpRow)
  25.             UpRow(i) = UpRow(i - 1) + 1       '依序將 UpRow 如  5-9 轉為陣列
  26.         Next
  27.     ElseIf InStr(UpRow, ",") Then
  28.         For Each E In Split(UpRow, ",")
  29.             If Not IsNumeric(E) Or i > E Then MsgBox Msg: End      '檢查是否為數字或小於上一個數字
  30.             i = E
  31.         Next
  32.         UpRow = Split(UpRow, ",")  '將 UpRow 如  5,9,11 轉為陣列
  33.     ElseIf IsNumeric(UpRow) Then
  34.         UpRow = Array(UpRow)
  35.     Else
  36.         MsgBox Msg: End
  37.     End If
  38.     For Each E In UpRow
  39.     '*** 做你想做的的事*****
  40.     '*** 也可呼叫 程式 (你想做的的事)
  41.     Next
  42.    
  43. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

Airman

帖子
315 
主題
51 
精華
0 
積分
367 
點名
0  
作業系統
win7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
註冊時間
2015-9-29 
最後登錄
2021-10-12 
11#
發表於 2018-6-24 19:54 | 只看該作者
回復 9# GBKEE
超版大：您好!
不好意思，本題原有2個細部需求，為避免文字說明"落落長"，易令人混淆不解，所以先只針對第1個細部需求做說明；第2個細部需求~等第1個細部需求解決後，再另做說明和討論。


備註：已將不相關的程式碼改為註解型態。
第1個需求：
依據UpRow InputBox填入的數字，顯示同樣編號和對等個數的效果檔案~
EX:UpRow = 填入"1-4"，可以得到T49_S欄最後n個值_1_200期；T49_S欄最後n個值_2_200期；T49_S欄最後n個值_3_200期；T49_S欄最後n個值_4_200期等四個效果檔案。
EX:UpRow = 填入"2,5,8"，可以得到T49_S欄最後n個值_2_200期；T49_S欄最後n個值_5_200期；T49_S欄最後n個值_8_200期等三個效果檔案。

※ 本需求不討論~
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\T49_S欄最後n個值_"& UpRow & "_" & mthcount & "期.xls"檔案的內容~
只要檔案之UpRow的”名稱”和檔案的”個數”正確即可。

DATA!列70~列94和列97和列100程式碼的錯誤~
勞駕您撥冗賜正~謝謝您^^

測試檔： TT49_S欄最後n個值(主檔).rar (29.05 KB)

TOP

Airman

帖子
315 
主題
51 
精華
0 
積分
367 
點名
0  
作業系統
win7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
註冊時間
2015-9-29 
最後登錄
2021-10-12 
10#
發表於 2018-6-23 19:33 | 只看該作者
回復 9# GBKEE
超版大:
謝謝您的耐心回應和指導。

晚上我重新整理主檔和效果檔及文字說明後，明天再請您賜教!謝謝您^^

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
9#
發表於 2018-6-23 15:15 | 只看該作者
回復 8# Airman
NUM = "10" ' InputBox("請選擇公式的起迄序號", "序號10-99")  **序號10-99 是指哪裡**
Nrange = "200" ' InputBox("請輸入運算的起迄期數", "輸入期數")  ** '起迄期數在哪裡**
UpRow = "1-3" ' InputBox("請選擇S欄最後n個值", "輸入1個-239個") ** 有看懂了**
要抓Data的哪些資料到
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\T49_S欄最後n個值_" & NUM & "_" & UpRow & "_" & mthcount & "期.xls"
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

Airman

帖子
315 
主題
51 
精華
0 
積分
367 
點名
0  
作業系統
win7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
註冊時間
2015-9-29 
最後登錄
2021-10-12 
8#
發表於 2018-6-23 09:01 | 只看該作者
本帖最後由 Airman 於 2018-6-23 09:02 編輯

回復 5# GBKEE

補充說明:
需求是~
EX:UpRow = 填入"1-3"，可以得到T49_S欄最後n個值_10_1_200期；T49_S欄最後n個值_10_2_200期；T49_S欄最後n個值_10_3_200期等三個效果檔案。
EX:UpRow = 填入"2,5,8"，可以得到T49_S欄最後n個值_10_2_200期；T49_S欄最後n個值_10_5_200期；T49_S欄最後n個值_10_8_200期等三個效果檔案。

但目前程式碼的效果是~
UpRow = 填入"1-3"，會跑出T49_S欄最後n個值_10_-1_200期；T49_S欄最後n個值_10_0_200期；T49_S欄最後n個值_10_1_200期；T49_S欄最後n個值_10_2_200期；T49_S欄最後n個值_10_3_200期等五個效果檔案。

EX:UpRow = 填入"2,5,8"，只跑出T49_S欄最後n個值_10_2_200期；T49_S欄最後n個值_10_5_200期等二個效果檔案。
   
程式碼錯誤的地方，敬請您賜正!謝謝您^^"

TOP

Airman

帖子
315 
主題
51 
精華
0 
積分
367 
點名
0  
作業系統
win7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
註冊時間
2015-9-29 
最後登錄
2021-10-12 
7#
發表於 2018-6-22 05:05 | 只看該作者
回復 5# GBKEE

可否再勞駕您撥冗賜正：
DATA!列70~列94和列97和列100程式碼的錯誤~
UpRow = 填入"1-3"
會多跑出下列2個錯誤的效果檔案~
T49_S欄最後n個值_10_0_200期
T49_S欄最後n個值_10_-1_200期
謝謝您^^

測試檔    T49_S欄最後n個值.rar (29.67 KB)

'UpRow..............................................................................列69
    M3 = 0                                   ‘列70
    sta = 0
For x = 1 To Len(uprowx)
    If Mid(UpRow, x, 1) = "," Then
        M3 = M3 + 1
        ReDim Preserve In3rr(M3 - 1)
        In3rr(M3 - 1) = --Mid(uprowx, sta + 1, 2)
        sta = x
        x = x + 2
    End If
    If Mid(UpRow, x, 1) = "-" Then
        For y = Mid(uprowx, sta + 1, 2) To Mid(uprowx, x + 1, 2)
            M3 = M3 + 1
            ReDim Preserve In3rr(M3 - 1)
            In3rr(M3 - 1) = y
        Next
        sta = x + 3
        x = x + 5
    End If
    If x = Len(uprowx) Then
        M3 = M3 + 1
        ReDim Preserve In3rr(M3 - 1)
        In3rr(M3 - 1) = --Mid(uprowx, sta + 1, 2)
    End If
Next                                             ‘列94
'.................................................................................
For n = 1 To M
For n3 = 1 To M3                                   ‘列97
   
    NUM = In1rr(n - 1)
    UpRow = In3rr(n3 - 1)                           ‘列100

TOP

Airman

帖子
315 
主題
51 
精華
0 
積分
367 
點名
0  
作業系統
win7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
註冊時間
2015-9-29 
最後登錄
2021-10-12 
6#
發表於 2018-6-14 19:35 | 只看該作者
回復 5# GBKEE

謝謝您的指導~我試試看^^

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2018-6-14 07:55 | 只看該作者
本帖最後由 GBKEE 於 2018-6-14 07:56 編輯

回復 4# Airman
可看Excel的說明  InputBox
有 InputBox 函數, InputBox方法可運用,自我練習看看
  1. '**Rows.Count -> 工作表的總行數(各版本總行數不一樣)**
  2.             If .[R6].End(xlDown).Row = Rows.Count Then
  3.                 MsgBox "沒有期數": Exit Sub
  4.             Else
  5.                 Qdown = .[R6].End(xlDown)
  6.             End If
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 有時當思無時苦，好天要積雨來糧。
12
返回列表 上一主題