返回列表 上一主題 發帖

如何讓inputbox 連續產生

回復 8# kerochen
StrPtr 是未公開的 function , 有問題可以改用
If ST = "" Then Exit Do   '按〔取消〕跳出
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

回復 4# 准提部林

Hi 准大, 我今天測試了, 要修改下列二個即可使用. 感謝.
只是會有當出現inputbox時,本身的取消無法離開, 要輸入0 or 000 即可跳出. 非常謝謝.


Sub Find_No()
Dim ST, xF As Range
Do
 ST = InputBox("數字")
 If ST = 0 Then Exit Do '按〔取消〕跳出
 If ST = "000" Then Exit Do '輸入〔特定值〕跳出
 If ST <> "" Then
   Set xF = [書本清冊!A2:A50].Find(ST, Lookat:=xlWhole)
   If xF Is Nothing Then
     MsgBox "找不到編號,請重新輸入! "
   Else
     xF.Resize(1, 2).Copy [擺放清單!A65536].End(xlUp)(2)
     Beep
   End If
 end If
Loop
End Sub

TOP

連續輸入也可以用call自己
  1. Sub test()
  2. Dim a As Integer
  3. a = InputBox("請輸入編號", "輸入")
  4. If a = 3 Then Exit Sub    ''輸入3離開
  5. Cells([A65536].End(xlUp).Row + 1, 1) = a   ''下一列開始輸入
  6. Call test
  7. End Sub
複製代碼

TOP

本帖最後由 准提部林 於 2015-10-6 14:34 編輯

沒檔案,只能猜,請自行去套:
  1. Sub Find_No()
  2. Dim ST, xF As Range
  3. Do
  4.  ST = InputBox("數字")
  5.  If StrPtr(ST) = 0 Then Exit Do '按〔取消〕跳出
  6.  If ST = "000" Then Exit Do '輸入〔特定值〕跳出
  7.  If ST <> "" Then
  8.    Set xF = [書本清冊!A2:A50].Find(ST, Lookat:=xlWhole)
  9.    If xF Is Nothing Then
  10.      MsgBox "找不到編號,請重新輸入! "
  11.    Else
  12.      xF.Resize(1, 2).Copy [擺放清單!A65536].End(xlUp)(2)
  13.      Beep
  14.    End If
  15.  End If
  16. Loop
  17. End Sub
複製代碼

TOP

回復 2# koo

謝謝,我待會試看看. 但更大的問題是在連續輸入…

TOP

要不要改用TextBox試試

有資料就換下一列
Ax = Sheets(2).[A65536].End(xlUp).Row + 1
Rows(n.Row).Copy Sheets(2).Cells(Ax, 1)

TOP

        靜思自在 : 站在半路,比走到目標更辛苦。
返回列表 上一主題