[發問] 不知發生出了甚麼狀況，還請各位大大給予協助

以下程式不知出了甚麼狀況，還請各位大大協助排除
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

小學生 Rank: 1

帖子: 4
主題: 2
精華: 0
積分: 6
點名: 0
作業系統: windows8.1
軟體版本: office2007
閱讀權限: 10
註冊時間: 2015-2-6
最後登錄: 2015-3-19

5^#

發表於 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

TOP

lpk187

高中生 Rank: 3 Rank: 3

帖子: 552
主題: 3
精華: 0
積分: 578
點名: 0
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2015-2-8
最後登錄: 2024-7-9

2016猴年全勤獎章 2015羊年全勤獎章熱烈參與勳章

4^#

發表於 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) '例如產品的單價
'依此類推

TOP

prince120101

中學生 Rank: 2

帖子: 25
主題: 7
精華: 0
積分: 53
點名: 0
作業系統: win7
軟體版本: 2010
閱讀權限: 20
性別: 男
註冊時間: 2014-12-4
最後登錄: 2018-6-6

3^#

發表於 2015-2-10 14:55 | 只看該作者

回復 2# indigpfbi

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

TOP

indigpfbi

小學生 Rank: 1

帖子: 4
主題: 2
精華: 0
積分: 6
點名: 0
作業系統: windows8.1
軟體版本: office2007
閱讀權限: 10
註冊時間: 2015-2-6
最後登錄: 2015-3-19

2^#

發表於 2015-2-10 11:35 | 只看該作者

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

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

TOP

[發問] 不知發生出了甚麼狀況，還請各位大大給予協助

[發問] 不知發生出了甚麼狀況，還請各位大大給予協助

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]