Один и тот же макрос на двух разных листах - работает на одном, прерывает на другом - PullRequest
0 голосов
/ 24 ноября 2018

У меня есть макрос, который я протестировал в рабочей тетради.Этот макрос успешно выполняется и обеспечивает ожидаемые результаты.Когда я копирую этот макрос в рабочую версию книги, макрос прерывается по разным причинам.Когда я выполняю макрос при отладке, код не выполняется ни как ожидалось.Например, в рабочей версии выполняется оператор 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`

1 Ответ

0 голосов
/ 24 ноября 2018

Предположение: данные загружаются в лист FEED_ANALYSIS диапазон E5: I11.Assumed layout Следующая угаданная проблема:

  1. После первого изменения в любой ячейке (или события вычисления) в FEED_ANALYSIS текущая дата добавляется в столбец A на листе LOG с переменной dtmTime (и рассматривается как datcomp в следующем событии).Поэтому дальнейшее обновление LOG из изменений ячеек в FEED_ANALYSIS предотвращается, как если бы предложение сравнивало dtmTime с datcomp и переходило к NoUpd:.
  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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...