返回列表 上一主題 發帖

[發問] 求助建立迴圈應用

本帖最後由 Hsieh 於 2011-6-4 11:53 編輯
  1. Sub test()
  2.     Dim mtstr As String, Wb As Workbook
  3.     On Error Resume Next
  4.     myStr = "選取資料OK後按確定鍵"
  5.     Set k = Application.InputBox(myStr, Type:=8)  'data範圍
  6.     If Err Then Exit Sub
  7.     Set Wb = Workbooks.Add    '開啟新活頁簿
  8.     ThisWorkbook.Activate
  9.     k.Copy Wb.ActiveSheet.[A3]
  10.     Set k = Nothing
  11.     Response = MsgBox("是否繼續", vbYesNo)
  12.     Do Until Response <> vbYes
  13.       Set k = Application.InputBox(myStr, Type:=8) 'data範圍
  14.       k.Copy Wb.ActiveSheet.[A65536].End(xlUp).Offset(1, 0) '指定儲存格 貼上資料
  15.       Set k = Nothing
  16.       Response = MsgBox("是否繼續", vbYesNo)
  17.     Loop
  18. End Sub
複製代碼
學海無涯_不恥下問

TOP

謝謝老師回復,再進一步請教老師
我這樣增加行列上去會影響程式的運作嗎?(我跑起來還好只是想了解觀念)
還有我可以在第一次選取資料時就一起顯示"如果要繼續選取請按[繼續]鍵"嗎?
感覺我這樣好像又多一次動作
請老師幫我指正

    Do Until Err.Number <> 0
     Dim Msg1, Style, Response, MyString
      Style = vbYesNo
      Msg1 = "是 / 否 繼續選取資料"
      Response = MsgBox(Msg1, Style)
        If Response = vbYes Then    ' 若使用者按下 [是]。
      Set k = Application.InputBox(myStr, Type:=8) 'data範圍
      k.Copy Wb.ActiveSheet.[A65536].End(xlUp).Offset(1, 0) '指定儲存格 貼上資料
      Set k = Nothing
            Else
             Exit Do    ' 產生相對回應。
        End If
      Loop
開心學習,學習很開心

TOP

  1. Sub test()
  2.     Dim mtstr As String, Wb As Workbook
  3.     On Error Resume Next
  4.     myStr = "選取資料OK後按確定鍵"
  5.     Set k = Application.InputBox(myStr, Type:=8)  'data範圍
  6.     If Err Then Exit Sub
  7.     Set Wb = Workbooks.Add    '開啟新活頁簿
  8.     ThisWorkbook.Activate
  9.     k.Copy Wb.ActiveSheet.[A3]
  10.     Set k = Nothing
  11.     Do Until Err.Number <> 0
  12.       Set k = Application.InputBox(myStr, Type:=8) 'data範圍
  13.       k.Copy Wb.ActiveSheet.[A65536].End(xlUp).Offset(1, 0) '指定儲存格 貼上資料
  14.       Set k = Nothing
  15.     Loop
  16. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 能付出愛心就是福,能消除煩惱就是慧。
返回列表 上一主題