如何讓inputbox 連續產生

kerochen

各路神人，小弟現有一困擾，就是當在核對書名時排上架時(擺放清單)，總是要剪剪貼貼。所以想用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

要不要改用TextBox試試

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

kerochen

回復 2# koo

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

准提部林

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

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

複製代碼

koo

連續輸入也可以用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

複製代碼

kerochen

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

准提部林

回復 8# kerochen


If StrPtr(ST) = 0 Then Exit Do '按〔取消〕跳出
您的版本無法使用嗎？

stillfish00

回復 8# kerochen
StrPtr 是未公開的 function , 有問題可以改用
If ST = "" Then Exit Do   '按〔取消〕跳出

kerochen

回復 8# 准提部林

是的= =. 還是謝謝准大. !

kerochen

回復 8# stillfish00

感謝!!  Still fish, 我明天上班試看看.