麻辣家族討論版版 » Excel程式區 » 新增與查找程式修改

返回列表下一主題上一主題發帖

新增與查找程式修改

中學生 Rank: 2

帖子: 63
主題: 34
精華: 0
積分: 103
點名: 0
作業系統: XP
軟體版本: office 2007
閱讀權限: 20
性別: 女
註冊時間: 2010-8-5
最後登錄: 2024-10-17

論壇榮譽勳章論壇贊助勳章

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2011-4-13 17:48 | 只看該作者

新增與查找程式修改

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

測試.rar (12.22 KB)

樓主熱帖

收藏

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

6^#

發表於 2014-2-6 08:25 | 只看該作者

回復 5# sheau-lan
最後加上

[F2].Resize(8) = ""

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

中學生 Rank: 2

帖子: 96
主題: 24
精華: 0
積分: 149
點名: 0
作業系統: WINDOWES
軟體版本: OFFICE
閱讀權限: 20
性別: 女
註冊時間: 2011-10-11
最後登錄: 2018-9-25

5^#

發表於 2014-2-5 20:47 | 只看該作者

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

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

4^#

發表於 2012-10-7 09:18 | 只看該作者

回復 3# sheau-lan
試試看

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

複製代碼

中學生 Rank: 2

帖子: 96
主題: 24
精華: 0
積分: 149
點名: 0
作業系統: WINDOWES
軟體版本: OFFICE
閱讀權限: 20
性別: 女
註冊時間: 2011-10-11
最後登錄: 2018-9-25

3^#

發表於 2012-10-6 22:39 | 只看該作者

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

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2011-4-13 19:34 | 只看該作者

回復 1# shootingstar

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

複製代碼

靜思自在 : 布施如播種，以歡喜心滋潤種子，才會發芽。

返回列表下一主題上一主題