Board logo

標題: 新增與查找程式修改 [打印本頁]
作者: shootingstar    時間: 2011-4-13 17:48     標題: 新增與查找程式修改

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

回復 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    時間: 2012-10-6 22:39

那如果要將指定資料刪除的程式應該是如何???
作者: GBKEE    時間: 2012-10-7 09:18

回復 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    時間: 2014-2-5 20:47

請問GBKEE大大
那如果要在輸入完畢後將以填在表單上的資料清除變成空白,以便輸入新的資料
應該怎麼做捏
作者: GBKEE    時間: 2014-2-6 08:25

回復 5# sheau-lan
最後加上
  1. [F2].Resize(8) = ""
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)