Airman
Lv 4
Airman 發問時間: 電腦與網際網路軟體 · 9 年前

VBA~InputBox的進階語法。

原NUM =InputBox("請選擇公式的起迄序號")

可輸公式的起迄序號︰單序號或連續序號。

單序號EX︰10或12或20。 連續期數EX︰10-12或11-14或20-25。

需求1︰

將NUM =InputBox("請選擇公式的起迄序號")

進階為

可輸入起迄序號型式︰單序號或複選序號或連續序號或複選連續序號或單序號連續序號綜合。

單序號EX︰10或12或20。 複選單序號EX︰10,12,20。

連續序號EX︰10-12或20-23。 複選連續序號EX︰10-12,20-25。

單序號連續序號綜合EX︰10,20,30-35,40,50-55,68。

原Nrange =InputBox("請輸入運算的起迄期數","輸入期數")

可輸入期數型式︰單期數或連續期數。

單期EX︰100或102。 連續期數EX︰100-102或200-205。

需求2︰

將NUM =InputBox("請選擇公式的起迄序號")

進階為

可輸入期數型式︰單期數或複選單期數或連續期數或複選連續期數或單期數連續期數綜合。

單期EX︰100或102。 複選單期數EX︰100,102或200,205,210。

連續期數EX︰100-102或200-201。 複選連續期數EX︰100-102,200-210。

單期數連續期數綜合EX︰100,200,300-305,400,590-592。

請問︰想進階為上述的二個需求~下列程式碼應該如何增編? 謝謝!

Private Sub CommandButton1_Click()Dim startrang%, endrang%, q%, t%, e%, s%, a, tim!,arr(48), brr(), tx%, ty%, b, Tname$, d, shcount% NUM =InputBox("請選擇公式的起迄序號") Nrange =InputBox("請輸入運算的起迄期數","輸入期數") tim =Timer [B2] ="" [F2] ="" Numx =NUMFor N = Left(Numx, 2) To Right(Numx, 2) NUM = N Sheets(2).Range("D" & NUM).Copy Sheets("DATA").[T7].Select ActiveSheet.Paste Application.ScreenUpdating = False '在背景下執行 Application.Calculation = xlCalculationManual '手動計算 K = 0 For I =1 To Len(Nrange) IfMid(Nrange, I, 1) = "-" Then K = 1 startrang = Left(Nrange, I - 1) endrang = Mid(Nrange, I + 1, 4) EndIf Next If K = 0Then startrang = Nrange endrang = Nrange End IfFor mthcount = startrang To endrang

︰︰︰NextNext[T1].Select[B2] = Numx & "=>"[F2] = startrang & "~" & endrang& "=" & Format((Timer - tim) / 24 / 60 / 60,"hh:mm:ss")End Sub

已更新項目:

抱歉!第3行和第16行有筆誤︰

第3行~

連續期數EX︰10-12或11-14或20-25。

應為︰

連續序號EX︰10-12或11-14或20-25。

第15行~需求2︰

第16行~

將NUM =InputBox("請選擇公式的起迄序號")

應為︰

將Nrange =InputBox("請輸入運算的起迄期數","輸入期數")

敬請見諒!謝謝!

^^"

1 個解答

評分
  • 顯栓
    Lv 7
    9 年前
    最佳解答

    Dim In1rr(), In2rr() numx = numFor x = 2 To Len(numx)  If Mid(num, x, 1) = "," Then   m = m + 1   ReDim Preserve In1rr(m - 1)   In1rr(m - 1) = --Mid(numx, sta + 1, 2)   sta = x   x = x + 2  End If  If Mid(num, x, 1) = "-" Then   For y = Mid(numx, sta + 1, 2) To Mid(numx, x + 1, 2)     m = m + 1    ReDim Preserve In1rr(m - 1)    In1rr(m - 1) = y   Next   sta = x + 3   x = x + 5  End If  If x = Len(numx) Then   m = m + 1   ReDim Preserve In1rr(m - 1)   In1rr(m - 1) = --Mid(numx, sta + 1, 2)  End IfNext m1 = 0 sta = 0 For I = 2 To Len(Nrange)  If Mid(Nrange, I, 1) = "," Then   m1 = m1 + 1   ReDim Preserve In2rr(m1 - 1)   In2rr(m1 - 1) = --Mid(Nrange, sta + 1, I - sta - 1)   sta = I  End If  If Mid(Nrange, I, 1) = "-" Then   For J = I + 1 To I + 5    If J > Len(Nrange) Then Exit For    If Mid(Nrange, J, 1) = "," Then     Exit For    End If   Next  For y = Mid(Nrange, sta + 1, I - sta - 1) To Mid(Nrange, I + 1, J - I - 1)   m1 = m1 + 1   ReDim Preserve In2rr(m1 - 1)   In2rr(m1 - 1) = y  Next  sta = J  I = J  End If  If I = Len(Nrange) Then   m1 = m1 + 1   ReDim Preserve In2rr(m1 - 1)   In2rr(m1 - 1) = --Mid(Nrange, sta + 1, I - sta)  End If NextFor n = 1 To m  num = In1rr(n - 1)    :  For m2 = 1 To m1 mthcount = In2rr(m2 - 1)    :  Next Next

還有問題?馬上發問,尋求解答。