[發問] 請問前輩們 如何讓VBA 依據欄位裡的名稱去搜索到同名稱的工作表

順勢而為

請問前輩們 如何讓VBA 依據欄位裡的名稱去搜索到同名稱的工作表
我做了一個銷貨系統  在"銷貨單"工作表上完成填寫後 按下指定的巨集
就會自動導入"銷貨清單"中
問題來了 因為客戶產品都不相同 所以須要把各客戶的銷貨清單分開
例如分成銷貨清單A為"A公司"工作表名稱和銷貨清單B為"B公司"工作表名稱
在A1欄位 設置了資料驗證的清單 可供選擇A公司、B公司
如何讓VBA 依據A1欄位的名稱 去搜尋到和A1欄位同名稱的工作表呢??
指令該如寫呢??
拜託前輩們指導指導我 非常感謝

lpk187

回復 1# 順勢而為

可以的話，最好上傳檔上來，比較可以得到較正確的答案
不然的話剛不久向准大學的語法，套進去你的程式也行
       SHN =Range("A1") '讀取A1儲存格的值，(A1欄位同名稱的工作表)
      On Error Resume Next'表示當一個執行階段錯誤產生時，程式控制立刻到發生錯誤陳述式接下去的陳述式
     Set xS = Sheets(SHN) '設定 xS 為尋找的工作表 如果找不到會產生錯誤，所以要有上一句和下一句
     On Error GoTo 0 '停止現在程序裏任何已啟動的錯誤處理程式
然後後面
With xS      'xS=Sheets("A公司")
      ...  
      ...
End With
以上僅供參考

順勢而為

回復 2# lpk187


    謝謝前輩願意指導
以傳上附件 只是A1欄位變成在O14  使用的巨集是"導入"  拜託前輩幫幫我 阿為由衷感謝

lpk187

回復 3# 順勢而為

考慮你不能下載檔案，所以只PO上程式碼，請自行換換置
原來的程式，大部份刪除掉了，嗯！太長了！陣列如此使用，會累死人的，所以我把它改掉了

1. Sub 導入()
   
2. 
   
3. With Sheets("銷貨單")
   
4.     If .[B12] = "" Then MsgBox "請輸入資料後再按按鈕 ": Exit Sub
   
5.     shN = .[O14]
   
6.     Ro = .[B27].End(xlUp).Row
   
7.     arr = .Range("C12:I" & Ro)
   
8.     日期 = .[h7]
   
9. End With
   
10. On Error Resume Next '表示當一個執行階段錯誤產生時，程式控制立刻到發生錯誤陳述式接下去的陳述式
    
11. Set xS = Sheets(shN) '設定 xS 為尋找的工作表 如果找不到會產生錯誤，所以要有上一句和下一句
    
12. On Error GoTo 0 '停止現在程序裏任何已啟動的錯誤處理程式
    
13. With xS
    
14.     xSro = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    
15.     .Cells(xSro, "B").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    
16.     .Range("A" & xSro & ":A" & xSro + UBound(arr, 1) - 1) = 日期
    
17. End With
    
18. Sheets("銷貨單").Select
    
19. Range("B12:B26,D12:D26,H7:H8,H5").ClearContents
    
20. Range("C4") = "S" & Format(Right(Range("C4"), 4) + 1, "0000")
    
21. 
    
22. End Sub

複製代碼

順勢而為

回復 4# lpk187

前輩真的是太感謝您了 ,一早醒來都感動到快流眼淚了。
我知道我那樣寫是笨蛋的方式,所以才不敢拿上來傳。
我是這1~2個月才自己從網路影片學習的超級門外漢
真的是幫了我好大的忙阿!!謝謝~萬分感謝您

准提部林

回復 2# lpk187

'↓由儲存格來指定工作表〔名稱〕
SHN =Range("A1")

'↓〔忽略〕程式錯誤，〔繼續〕往下執行後面的指令
On Error Resume Next　
　
'↓設定 xS 給〔指定工作表〕，如果該工作表不存在，會產生〔錯誤並中斷〕在這一行，
Set xS = Sheets(SHN)　　'因為有上一句，程式不中斷而往下執行

'↓〔恢復〕程式錯誤處理，亦即 On Error Resume Next 到這行以後就〔失效〕，
'　其後程式若有錯誤，一樣會產生〔中斷〕，不然下方程式有錯誤就無法發現！
On Error GoTo 0

'↓所以，還是要加這行以〔提醒〕使用者，並〔跳離〕程式
If xS Is Nothing Then MsgBox "工作表不存在": Exit Sub　　

'↓上方都沒問題，才會執行以下的程式碼，以避免無法預知的錯誤，造成資料錯誤
With xS      'xS=Sheets("A公司")
      ...  
End With

lpk187

回復 6# 准提部林

對吼！忘記加了，感謝准大提醒！謝謝

順勢而為

回復 6# 准提部林

准提部林版大: 謝謝您的寶貴提醒 ,的確有這一點小小的狀況 。
但是版大 If xS Is Nothing Then MsgBox "工作表不存在": Exit Sub
這行貼上去後 我去做一個沒有工作表的執行
指令只跑到   If xS Is Nothing Then 就出現偵錯了
而不會繼續跑 MsgBox "工作表不存在": Exit Sub 這段錯誤提醒
請問我是哪個部分錯了??

1. Sub 導入()
   
2. Application.ScreenUpdating = False
   
3. With Sheets("銷貨單")
   
4. 
   
5. If .[B12] = "" Then MsgBox "請輸入資料後再按按鈕 ": Exit Sub
   
6.     shN = .[O14]
   
7.     Ro = .[B27].End(xlUp).Row
   
8.     arr = .Range("C12:I" & Ro)
   
9.     日期 = .[h7]
   
10. End With
    
11. On Error Resume Next '表示當一個執行階段錯誤產生時，程式控制立刻到發生錯誤陳述式接下去的陳述式
    
12. Set xS = Sheets(shN) '設定 xS 為尋找的工作表 如果找不到會產生錯誤，所以要有上一句和下一句
    
13. On Error GoTo 0 '停止現在程序裏任何已啟動的錯誤處理程式
    
14. 
    
15. If xS Is Nothing Then MsgBox "工作表不存在": Exit Sub
    
16. 
    
17. With xS
    
18.     xSro = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    
19.     .Cells(xSro, "B").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    
20.     .Range("A" & xSro & ":A" & xSro + UBound(arr, 1) - 1) = 日期
    
21. End With
    
22. Sheets("銷貨單").Select
    
23. Range("B12:B26,D12:D26,H7:H8,H5").ClearContents
    
24. Range("C4") = "S" & Format(Right(Range("C4"), 4) + 1, "0000")
    
25. Range("O14").Select
    
26. Application.ScreenUpdating = True
    
27. End Sub

複製代碼

順勢而為

回復 7# lpk187

真的很感謝您~

lpk187

回復 8# 順勢而為

你把If xS Is Nothing Then MsgBox "工作表不存在": Exit Sub把這列放到
On Error GoTo 0 上面看看