[發問] 跨工作表並指定儲存格在往下迴圈查詢

BV7BW

問題1:        工作表1(A,B,C,D,E,F)欄中,由數量(D)欄內儲存格判斷依據帶出資料轉換到工作表3(A,B,C,D,E,F)欄,(例如工作表3)依序迴圈往下排列                                                                                                               
                其工作表1中名稱(A)欄是下拉清單,編號(B)欄,商品(C)欄,價格(E)欄是固定資料,數量(D)欄是人工填入,總價(F)欄是(D2)*(E2)                                                                                                               
        問題2:        如轉換到工作表2可指定儲存格?當工作表1數量(D)欄由人工填入後用巨集按扭轉換到工作表2                                                                                                               
                例如:工作表1(A2)轉工作表2(B2),工作表1(B2)轉工作表2(B6),工作表1(C2)轉工作表2(C6),                                                                                                                    
                         工作表1(D2)轉工作表2(D6),工作表1(E2)轉工作表2(E6),工作表1(F2)轉工作表2(F6),                                                                                                               
                其中工作表1(A2)只帶出1次,其餘(B2:B12,C2:C12,D2:D12,E2:E12,F2:F12)依序迴圈往下排列                                                                                                               
問題1與問題2:                皆因是由數量(D)欄內儲存格中作為判斷依據帶出編號(B)欄,商品(C)欄,價格(E)欄,總價(F)欄,所以數量(D)欄是不確定哪列儲存格有數字                                                                                                               
                當數量(D)欄某一列儲存格有數字出現(或變化異動),也就是數量(D)欄某一列中出現0.1到99.9(或是有變化異動)時既可觸發帶出(B,C,D,E,F)欄                                                                                                               
                沒出現數字(或沒變化異動)的儲存格就不用帶出再繼續迴圈往下查詢至最後一列

准提部林

1. Sub 轉出資料()
   
2. Dim R&, xR As Range, xE As Range, N&
   
3. If [工作表1!A2] = "" Then MsgBox "**尚未填入名稱! ": Exit Sub
   
4. R = [工作表1!B65536].End(xlUp).Row - 1
   
5. If Application.Sum([工作表1!D2].Resize(R)) = 0 Then
   
6.    MsgBox "**尚未填入數量! ": Exit Sub
   
7. End If
   
8. [工作表2!B6:F200].ClearContents
   
9. [工作表2!B2] = [工作表1!A2]
   
10. For Each xR In [工作表1!B2].Resize(R)
    
11.     If Val(xR(1, 3)) = 0 Then GoTo 101
    
12.     N = N + 1
    
13.     [工作表2!B5:F5].Offset(N, 0) = xR.Resize(, 5).Value
    
14.     '----------------------------
    
15.     Set xE = [工作表3!D65536].End(xlUp)(2, -1)
    
16.     If N = 1 Then xE(1, 0) = [工作表1!A2]
    
17.     xE.Resize(, 5) = xR.Resize(, 5).Value
    
18. 101: Next
    
19. With [工作表1!D2].Resize(R)
    
20.      .Copy [工作表1!H2] '數量貼至備存區, 以供參考
    
21.      .ClearContents '清空數量, 待下次重新輸入
    
22. End With
    
23. [工作表1!A2] = "" '清空名稱, 待下次重新輸入
    
24. [工作表1!i2] = Date: [工作表1!i3] = Time '記錄轉出日期時間
    
25. End Sub

複製代碼

Xl0000100.rar (16.61 KB)

下載次數: 30

2020-4-30 11:04

'=========================

BV7BW

謝謝准大
這些正是我想要做法.我用2個月時間網路練習作法想不到准大在幾小時內解析出,真是高手,高手,高高手謝謝你
因我是(60)進入Excel2個多月,請容我一一分解.真是謝謝你

BV7BW

回復 2# 准提部林

准大先進老師及各位先進前輩,不計另嗇多方指導"謝謝"                                                                                                                               
如上題有多方面理解獲益匪淺,但只理解皮毛.未深入原理.懇請再容多加努力.努力學習探討,(例如Dim R&, xR As Range, xE As Range, N&這些出至哪裡.函意為何                                                                                                                               
今如上題中再新增項目.請再賜教"謝謝"

BV7BW

回復 4# BV7BW


    抱歉.上傳資料有誤.再補船1次 抱歉

准提部林

回復 5# BV7BW


類似"進/銷貨"單吧!
進銷存>牽涉到[新增-查詢-更改-刪除]問題,
這費時耗力, 實無法這樣逐步跟帖,
可自行先網搜找看看有沒現成的檔案範例或程式碼參考!!!

Dim ~~~~  只是定義[變數], 可看vbe說明檔, 或G搜關鍵字__excel vba 變數

BV7BW

回復 6# 准提部林


   感謝准大先進.指導
   我在朝這方面努力探討.謝謝你
   如有不便之處.望請諒解...謝謝

BV7BW

回復 6# 准提部林


    修改後版本之增列部分
     [工作表6!G2] = [工作表1!G2]
     [工作表6!H2] = [工作表1!H2]
     [工作表6!I2] = [工作表1!I2]
     [工作表6!J2] = Date '記錄轉出日期時間
    [工作表1!I2] = Range("I2") + 1
Copy [工作表1!J2] '數量貼至備存區, 以供參考
不知從哪修改為往下排列
望請准大勞心指教
如蒙賜教,實感德惠

准提部林

回復 8# BV7BW


看不懂意圖~~
而且進銷單應不可能是如此簡單的格式,
商品項目若很多, 這種格式就不夠使用,
若再考慮後續的統計(例如:月結請款), 資料表也不能這樣設計!!!
================================
也許你可能只是想學習VBA, 但一下就找這種題目, 教個一年半載是跑不掉的,
還是建議去找找現成的帖子看看, 最好也去買VBA基礎書籍,
把基本功打好, 至少得能看懂別人寫的程式碼!

准提部林

這是個簡易法, 只有存入, 沒有更改及刪除,
雖是簡單做法, 還是要花大半天寫程式及設計表格:
X0066.rar (24.74 KB)

下載次數: 15

2020-5-15 14:18

等完全看得懂裡面的程式碼, 有問題再說~~