如何讓inputbox 連續產生

各路神人，小弟現有一困擾，就是當在核對書名時排上架時(擺放清單)，總是要剪剪貼貼。所以想用excel 寫一個迴圈程式，讓店長能直接輸入數字後，能對應到表格剪下來，產生另一份的擺放清單。但不知要怎麼讓inputbox 能有連續輸入的功能，及當輸入到特定值時能自動關掉。煩請指導了，謝謝

dim n as page
st = application.inputbox("數字", type:=1)
for each n in page("A2"A50")
if n.value=st then
range(Cells(st+1,"A"),Cells(st+1,"B")).select
(已選上的拷貝到sheet(2), 貼上(假設有文字的話跳到下一行) '這段不會寫
msgbox"已選上 " & Cells(st+1,"B").text

else
if st=0
msgbox"已完成選項"

end if
next

樓主熱帖

koo

中學生 Rank: 2

帖子: 60
主題: 4
精華: 0
積分: 64
點名: 0
作業系統: w7-32
軟體版本: 2013.2003
閱讀權限: 20
註冊時間: 2014-11-23
最後登錄: 2016-6-6

2^#

發表於 2015-10-4 18:45 | 只看該作者

要不要改用TextBox試試

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

TOP

kerochen

小學生 Rank: 1

帖子: 15
主題: 3
精華: 0
積分: 30
點名: 0
作業系統: win7
軟體版本: 2010
閱讀權限: 10
註冊時間: 2014-5-29
最後登錄: 2015-10-23

3^#

發表於 2015-10-4 19:35 | 只看該作者

回復 2# koo

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

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-23

4^#

發表於 2015-10-4 20:50 | 只看該作者

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

沒檔案，只能猜，請自行去套：

Sub Find_No()
Dim ST, xF As Range
Do
　ST = InputBox("數字")
　If StrPtr(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

koo

中學生 Rank: 2

帖子: 60
主題: 4
精華: 0
積分: 64
點名: 0
作業系統: w7-32
軟體版本: 2013.2003
閱讀權限: 20
註冊時間: 2014-11-23
最後登錄: 2016-6-6

5^#

發表於 2015-10-5 02:59 | 只看該作者

連續輸入也可以用call自己

Sub test()
Dim a As Integer
a = InputBox("請輸入編號", "輸入")
If a = 3 Then Exit Sub ''輸入3離開
Cells([A65536].End(xlUp).Row + 1, 1) = a ''下一列開始輸入
Call test
End Sub

複製代碼

TOP

kerochen

小學生 Rank: 1

帖子: 15
主題: 3
精華: 0
積分: 30
點名: 0
作業系統: win7
軟體版本: 2010
閱讀權限: 10
註冊時間: 2014-5-29
最後登錄: 2015-10-23

6^#

發表於 2015-10-5 22:43 | 只看該作者

回復 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

准提部林