在两个不同的工作表上使用相同的宏-在一个工作表上工作，在另一个工作表上中止

Question

我有一个在开发工作簿上测试过的宏。该宏成功运行并提供了预期的结果。当我将此宏复制到工作簿的生产版本时，该宏由于各种原因而中止。当我逐步调试宏时，代码未按预期执行。例如，在生产版本中，将执行测试日期的IF语句，然后执行第一个.Cells语句，然后宏中止。

不知道原因。任何想法将不胜感激。

Private Sub Worksheet_Calculate()
Dim Cost_Per_day
Dim COST_kg
Dim AVG_SALES_PRICE
Dim COST_NET_PURCHASE
Dim PROFIT_GROSS
Dim PROFIT_NET
Dim PROFIT_NET_X
Dim Flag_set

Dim dtmTime As Date
Dim Rw As Long

'If Critical Cells change, move contents to Log sheet

Dim Xrg As Range
Set Xrg = Range("E5:I11")
If Not Intersect(Xrg, Range("E5:I11 ")) Is Nothing Then



dtmTime = Now()
Cost_day = Worksheets("FEED_ANALYSIS").Range("E7").Value
COST_kg = Worksheets("FEED_ANALYSIS").Range("F7").Value
AVG_SALES_PRICE = Worksheets("FEED_ANALYSIS").Range("I5").Value
COST_NET_PURCHASE = Worksheets("FEED_ANALYSIS").Range("G11").Value
PROFIT_GROSS = Worksheets("FEED_ANALYSIS").Range("I7").Value
PROFIT_NET = Worksheets("FEED_ANALYSIS").Range("I8").Value
PROFIT_NET_X = Worksheets("FEED_ANALYSIS").Range("I9").Value



Rw = Sheets("LOG").Range("A" & Rows.Count).End(xlUp).Row + 1

With Sheets("LOG")
    datcomp = .Cells(Rw - 1, 1)

   ' if the previous entry date is the same as the current date, do not create the entries... one entry per day`

    If Year(datcomp) = Year(dtmTime) And Month(datcomp) = Month(dtmTime) And Day(datcomp) = Day(dtmTime) Then GoTo NoUpd

    .Cells(Rw, 1) = dtmTime
    .Cells(Rw, 2) = Cost_Per_day
    .Cells(Rw, 3) = COST_kg
    .Cells(Rw, 4) = AVG_SALES_PRICE
    .Cells(Rw, 5) = COST_NET_PURCHASE
    .Cells(Rw, 6) = PROFIT_GROSS
    .Cells(Rw, 7) = PROFIT_NET
    .Cells(Rw, 8) = PROFIT_NET_X
    .Cells(Rw, 11) = .Cells(Rw - 1, 1)
 NoUpd:
 End With

 End If

 End Sub`

Answer 1

假设：正在将数据馈入工作表FEED_ANALYSIS范围E5：I11。 以下问题被猜到了：

1. 在FEED_ANALYSIS的任何单元格（或计算事件）中首次更改之后，当前日期将被添加到工作表LOG中的变量dtmTime的col A中（在下一个事件中被视为datcomp）。因此，就好像子句将dtmTime与datcomp比较并分支到NoUpd:一样，阻止了FEED_ANALYSIS中单元格更改引起的LOG的进一步更新。
2. 我认为代码将始终在工作表的计算事件上触发。 If Not Intersect(Xrg, Range("E5:I11 ")) Is Nothing Then将始终为真。
3. Cost_Per_day和Cost _day的错字可能会在.Cells(Rw, 2) = Cost_Per_day处引发错误

如果以上假设正确，则可以尝试使用FEED_ANALYSIS中的代码。试图使修改保持最小。

Option Explicit       'added
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cost_Per_day
Dim COST_kg
Dim AVG_SALES_PRICE
Dim COST_NET_PURCHASE
Dim PROFIT_GROSS
Dim PROFIT_NET
Dim PROFIT_NET_X
Dim Flag_set
Dim dtmTime As Date
Dim datcomp As Date   'added
Dim Rw As Long
Dim LastRw As Long    ' added
Dim PrvRw As Long     'added
'If Critical Cells change, move contents to Log sheet

Dim Xrg As Range
Set Xrg = Range("E5:I11")
If Not Intersect(Target, Xrg) Is Nothing Then

dtmTime = Now()
Cost_Per_day = Worksheets("FEED_ANALYSIS").Range("E7").Value  ' Cost_day changed to Cost_Per_day as per Dim
COST_kg = Worksheets("FEED_ANALYSIS").Range("F7").Value
AVG_SALES_PRICE = Worksheets("FEED_ANALYSIS").Range("I5").Value
COST_NET_PURCHASE = Worksheets("FEED_ANALYSIS").Range("G11").Value
PROFIT_GROSS = Worksheets("FEED_ANALYSIS").Range("I7").Value
PROFIT_NET = Worksheets("FEED_ANALYSIS").Range("I8").Value
PROFIT_NET_X = Worksheets("FEED_ANALYSIS").Range("I9").Value


LastRw = Sheets("LOG").Range("A" & Rows.Count).End(xlUp).Row + 1
PrvRw = LastRw - 1
With Sheets("LOG")
    datcomp = .Cells(PrvRw, 1)

   ' if the previous entry date is the same as the current date then
   ' choose previous entry row to update other data
   ' else
   ' Chose last row  for new entry
   ' But this approach will not work if data is not enetered  for some unforeseen
   ' reason before 23:59 hrs of currect date i.e dtmTime = Now()
   ' Better to use datetime from a manually entered cell in sheet "FEED_ANALYSIS"
   ' with some validation

    If Year(datcomp) <> Year(dtmTime) Or Month(datcomp) <> Month(dtmTime) Or Day(datcomp) <> Day(dtmTime) Then
    Rw = LastRw
    .Cells(Rw, 1) = dtmTime
    Else
    Rw = PrvRw
    End If

    .Cells(Rw, 1) = dtmTime
    .Cells(Rw, 2) = Cost_Per_day
    .Cells(Rw, 3) = COST_kg
    .Cells(Rw, 4) = AVG_SALES_PRICE
    .Cells(Rw, 5) = COST_NET_PURCHASE
    .Cells(Rw, 6) = PROFIT_GROSS
    .Cells(Rw, 7) = PROFIT_NET
    .Cells(Rw, 8) = PROFIT_NET_X
    .Cells(Rw, 11) = .Cells(Rw - 1, 1)
End With
End If
End Sub