新增與查找程式修改

shootingstar

自己建了一個庫存表如附件，也照書各寫了一個新增與查找的VBA程式，新增是沒問題的，我可以在輸入表單的輸入欄位內輸入資料後，資料會自動轉寫到我指定的工作表內，但如果是像附檔那樣，我有6個工作表，要如何更改程式碼讓他依輸入表單內的F2儲存格裡的型號自動轉寫到該工作表。
另一個問題就是，查找無法執行，執行後會出現 執行階段錯誤錯誤"1004": 'Range'方法('_Gloable'物件)失敗，因為我是照書寫的，沒有除錯的能力，希望各位前輩指導。
還有就是在輸入表單，可以鎖住當我在入出庫單號內輸入的是"O"、"P"、"T"開頭的單號，就只能在出庫輸入數量，如果是"I"開頭的單號就鎖定只能載入庫輸入數量。
以上，謝謝。

GBKEE

回復 1# shootingstar

1. Sub 轉寫()
   
2.     Dim motoHani As Range, sakisht As Worksheet, sakrng As Range
   
3.     Set motoHani = [F3].Resize(7)
   
4.     If IsError(Application.Match([F2], [B3:B8], 0)) Then MsgBox "沒有 型號!! ": Exit Sub
   
5.     If [F5] = "" Then MsgBox "沒有 入出庫單號!! ": Exit Sub
   
6.     Set sakisht = Worksheets([F2].Value)
   
7.     Set sakrng = sakisht.Range("A" & Rows.Count).End(xlUp).Offset(1)
   
8.     sakrng.Resize(, 7).Value = Application.Transpose(motoHani)
   
9.     MsgBox "輸入完畢"
   
10. End Sub
    
11. Sub 查找()
    
12.     Dim motoHani, myRng As Range
    
13.     Set motoHani = [F3].Resize(7)
    
14.     If IsError(Application.Match([F2], [B3:B8], 0)) Then MsgBox "沒有 型號!! ": Exit Sub
    
15.     If [F5] = "" Then MsgBox "沒有 入出庫單號!! ": Exit Sub
    
16.     Set myRng = Sheets([F2].Value).Columns(3).Find([F5], LookAt:=xlWhole)
    
17.     If myRng Is Nothing Then MsgBox "沒有符合條件的資料！":   Exit Sub
    
18.     Set myRng = Sheets([F2].Value).Cells(myRng.Row, 1)
    
19.     Set myRng = myRng.Resize(, 7)
    
20.     motoHani.Value = Application.Transpose(myRng)
    
21. End Sub

複製代碼

sheau-lan

那如果要將指定資料刪除的程式應該是如何???

GBKEE

回復 3# sheau-lan
試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     查找 "查找"   'xlword 參數
   
4.     查找 "刪除"   'xlword 參數
   
5. End Sub
   
6. Sub 查找(xlword As String)   'xlword 傳遞的參數 為 "查找" 或 "刪除"
   
7.     Dim motoHani, myRng As Range
   
8.     Set motoHani = [F3].Resize(7)
   
9.     If IsError(Application.Match([F2], [B3:B8], 0)) Then MsgBox "沒有 型號!! ": Exit Sub
   
10.     If [F5] = "" Then MsgBox "沒有 入出庫單號!! ": Exit Sub
    
11.     Set myRng = Sheets([F2].Value).Columns(3).Find([F5], LookAt:=xlWhole)
    
12.     If myRng Is Nothing Then MsgBox "沒有符合條件的資料！":   Exit Sub
    
13.     Set myRng = Sheets([F2].Value).Cells(myRng.Row, 1)
    
14.     If xlword = "查找" Then                           'xlword 傳遞的參數 為 "查找"
    
15.         Set myRng = myRng.Resize(, 7)
    
16.         motoHani.Value = Application.Transpose(myRng)
    
17.     ElseIf xlword = "查找" Then                       'xlword 傳遞的參數 為 "刪除"
    
18.         myRng.Resize(, 7).Delete Shift:=xlUp          '在這裡刪除資料
    
19.     End If
    
20. End Sub

複製代碼

sheau-lan

請問GBKEE大大
那如果要在輸入完畢後將以填在表單上的資料清除變成空白,以便輸入新的資料
應該怎麼做捏

GBKEE

回復 5# sheau-lan
最後加上

1. [F2].Resize(8) = ""

複製代碼