iT邦幫忙

0

Excel VBA 巨集設計問題 VLOOKUP帶出邏輯運算後的內容

小弟對VBA編寫不是太熟識, 網上找了很多資料也找不到相同的做法,

現在我有兩個不一樣格式的管理表, 我希望便用VBA將表B的內容經運算後自動帶出至表A

按邏輯來說我覺得是可以用VBA做的到, 想請求各位大大請教做法的可能性和做法
詳細如下

表A和表B如圖下
https://ithelp.ithome.com.tw/upload/images/20210428/201277721p9mjtxbMo.png
https://ithelp.ithome.com.tw/upload/images/20210428/201277724oTnKeorWR.png

首先表A要登錄的內容會先按 表B的H行"個口數"來判斷
邏輯的推算大至上只有3種

  1. 如表B H4的個口數為1,
    表A就需要登錄兩欄 一個是以正的商品編號(E4)需要帶出的總數(表A的C行)為表L行的內容(即L4)
    而另一欄側需要登錄半的商品編號(F4)需要帶出的總數為M行的內容(即M4)

  2. 如表B H8的個口數為2,
    表A只需要登錄一欄 會以半的商品編號(F8)需要帶出的總數(表A的C行)為表K行的數量X2, 即K8=137, 表A的總數便需要為274

  3. 如表B H6的個口數為4,
    表A只需要登錄一欄 會以特的商品編號(D6)需要帶出的總數(表A的C行)為表K行的數量X4, 即K6=35, 表A的總數便需要為140

以上圖片為例, 完全效果表A在運算VBA後 希望得出以下效果
https://ithelp.ithome.com.tw/upload/images/20210428/20127772N0spvmrItz.png

1 個回答

0
海綿寶寶
iT邦大神 1 級 ‧ 2021-04-28 22:09:56
最佳解答

如果前一個問題解決了的話
請選個最佳解答以進行結案動作

Sub MainLoop()
    R = 4
    
    Do While Sheets("表B").Cells(R, 8) = 1 Or Sheets("表B").Cells(R, 8) = 2 Or Sheets("表B").Cells(R, 8) = 4
        
        sVendor = Sheets("表B").Cells(R, 2)     '廠商
        sUnitPrice = Sheets("表B").Cells(R, 14) '單價
        
        Select Case Sheets("表B").Cells(R, 8)
            Case 1
                sProduct = Sheets("表B").Cells(R, 5)    '產品
                sTotal = Sheets("表B").Cells(R, 12)     '總價
        
                Call AddRowSheetA(sVendor, sProduct, sTotal, sUnitPrice)
            
                sProduct = Sheets("表B").Cells(R, 6)
                sTotal = Sheets("表B").Cells(R, 13)
        
                Call AddRowSheetA(sVendor, sProduct, sTotal, sUnitPrice)
            Case 2
                sProduct = Sheets("表B").Cells(R, 6)
                sTotal = Sheets("表B").Cells(R, 11) * 2
        
                Call AddRowSheetA(sVendor, sProduct, sTotal, sUnitPrice)
            Case 4
                sProduct = Sheets("表B").Cells(R, 4)
                sTotal = Sheets("表B").Cells(R, 11) * 4
        
                Call AddRowSheetA(sVendor, sProduct, sTotal, sUnitPrice)
        End Select        
        
        R = R + 1
    Loop
End Sub
Sub AddRowSheetA(ByVal pVendor, ByVal pProduct, ByVal pTotal, ByVal pUnitprice)
    R = Range("表A!A65536").End(xlUp).Row + 1
    Sheets("表A").Cells(R, 1) = pVendor
    Sheets("表A").Cells(R, 2) = pProduct
    Sheets("表A").Cells(R, 3) = pTotal
    Sheets("表A").Cells(R, 4) = pUnitprice
End Sub

我要發表回答

立即登入回答