標題: [發問] 不知發生出了甚麼狀況，還請各位大大給予協助 [打印本頁]

---

作者: indigpfbi    時間: 2015-2-9 19:50     標題: 不知發生出了甚麼狀況，還請各位大大給予協助

以下程式不知出了甚麼狀況，還請各位大大協助排除
Private Sub Worksheet_Change(ByVal TARGET As Range)
Dim i As Long
i = 3
Do While Cells(i, "A") <> Sheets("庫存總表").[B2:B65536]


With TARGET


'If .Row >= 1 And .Column = 1 Then

  .Offset(0, 2) = Application.VLookup(.Value, Sheets("庫存總表").[B2:K65536], 3, False)
  .Offset(0, 3) = Application.VLookup(.Value, Sheets("庫存總表").[B2:K65536], 4, False)
  .Offset(0, 4) = Application.VLookup(.Value, Sheets("BOM").[A2:K65536], 5, False)
  .Offset(0, 5) = Application.VLookup(.Value, Sheets("BOM").[A2:K65536], 5, False) * Range("B1")
  .Offset(0, 6) = Application.VLookup(.Value, Sheets("庫存總表").[B2:K65536], 5, False)
  .Offset(0, 7) = Application.VLookup(.Value, Sheets("庫存總表").[B2:K65536], 5, False) _
                    - Application.VLookup(.Value, Sheets("BOM").[A2:K65536], 5, False) * Range("B1")
  .Offset(0, 8) = Application.VLookup(.Value, Sheets("庫存總表").[B2:K65536], 8, False)
  
    If .Offset(0, 7) < Application.VLookup(.Value, Sheets("庫存總表").[B2:K65536], 8, False) Then
   
       .Offset(0, 7).Font.Color = RGB(255, 0, 0)
      
    Else
      
       .Offset(0, 7).Font.Color = RGB(0, 0, 0)
      
    End If



End With
i = i + 1
Loop


End Sub

執行時在第三行出現型態不符合的錯誤訊息視窗，百思不得其解
還希望各位大大能協助確認
謝謝

---

作者: indigpfbi    時間: 2015-2-10 11:35

小弟是要製作一個庫存管理系統，希望能夠在工作頁上Key入產品料號後，工作頁就會從資料庫中把此產品的相關零件列出，最後再填入需求數量，此工作頁就能幫忙帶出各零件實際支出數量，最終在把此實際支出數量與資料庫內相關零件相減後的結果寫入資料庫

因為小弟對VBA還不甚熟悉，還請線上各位高手大大協助完成
謝謝

---

作者: prince120101    時間: 2015-2-10 14:55

回復 2# indigpfbi

indigpfbi大
你要不要提供一個動作流程 圖or檔案
這樣會比較好理解~

---

作者: lpk187    時間: 2015-2-10 15:16

我的做法 , 很少帶入函數寫都用以下的做法

產品編號 = [A1]
XX = Worksheets("工作表2").Columns(1).Find(產品編號, , , xlWhole, , xlPrevious).Row '找尋該產品的行號
[B1] = Worksheets("工作表2").Cells(2, XX) '例如產品名稱
[C1] = Worksheets("工作表2").Cells(3, XX) '例如產品的單價
'依此類推

---

作者: indigpfbi    時間: 2015-2-10 18:05

感謝各位大大協助
目前暫時已找到解決方法
修正成利用既有備料表，對資料庫進行比對，再將所需資料帶入
這隻程式其實是參考版主在
http://forum.twbts.com/thread-12992-1-9.html
裡面回覆的程式加以修改的

分享給各位有需要的板友參考並請給予指教
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, Range("B1")) Is Nothing Or Target.Count > 1 Then '如果更改的儲存格不是B列第三行以下的儲存格或更改的儲存格個數大於1時退出程式
        Exit Sub
  End If
    Dim Rng, Ar, R As Range, ii As Integer, i As Integer
    Ar = Worksheets("庫存總表").Range("B2").CurrentRegion.Value  '資料庫
     Set Rng = Range("A2", Range("A2").End(xlDown)).Resize(, 2)
    For Each R In Rng.Rows
        For ii = 1 To UBound(Ar, 1)
            If R.Cells(2, 1) & R.Cells(2, 2) = Ar(ii, 2) & Ar(ii, 3) Then '項目1與項目2和資料庫項目2與項目3一樣
                R.Cells(2, 7) = Ar(ii, 6) '項目7填入資料庫項目6內容
                R.Cells(2, 9) = Ar(ii, 9) '項目9填入資料庫項目9內容
                R.Cells(2, 6) = R.Cells(2, 5) * Range("B1") '項目6(生產用量)填入項目5(基本用量)*儲存格B1的值
                R.Cells(2, 8) = R.Cells(2, 7) - R.Cells(2, 6) '項目8(剩餘數量)=庫存量-生產用量
               
                 If R.Cells(2, 8) < R.Cells(2, 9) Then '把剩餘數量跟最低庫存數進行比對，若是小於
   
               R.Cells(2, 8).Font.Color = RGB(255, 0, 0) '數字變成紅色
      
               Else
      
               R.Cells(2, 8).Font.Color = RGB(0, 0, 0) '數字顏色維持不變
      
             End If
               
                Exit For
            End If
        Next
    Next
End Sub

---

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