Здравствуйте.
Не могу справиться с проблемой (по поиску пошерстил аналогичные темы, в том числе и здесь).
фрагмент кода такой:
суть в максимизации целевой функции (где Worksheets(2).Cells(7, 876) - разница нового и предыдущего значений целевой функции) через добавление ранее удалённых строк (если после возврата строк она не увеличивается, удаляю опять).
Примерно на 70-й возвращённой и снова удалённой строке выскакивает баг (если ClearContents заменить на копи-пэйст значений ячеек пустой строки или же вообще приравниванием нулю, то ошибка всё равно вылезает, только с другим описанием).
Что совсем непонятно, так это то, что просто перевернул вполне работающий код оптимизации через удаление строк, где ошибка, если и вылезает, то после нескольких сотен или тысяч удалённых и заново возвращённых строк:
Не могу справиться с проблемой (по поиску пошерстил аналогичные темы, в том числе и здесь).
фрагмент кода такой:
| Код |
|---|
Sub ExpSelRev() a = 1589 b = 2940 c = 1352 S = 1 m = 1 n = 1 For r = n To n For k = 0 To m - 1 For i = a + k * c To a + (k + 1) * c - 1 Step S If Worksheets(1).Cells(i, 8 ) > 0 _ Then GoTo Next1 If Worksheets(1).Cells(i, 8 ) = 0 _ Then Worksheets(1).Range(Cells(3173, 8 ), Cells(3173, 844)).Copy Worksheets(1).Range(Cells(i, 8 ), Cells(i, 844)).PasteSpecial Paste:=xlPasteFormulas End If Application.Calculate If Worksheets(2).Cells(7, 876) > 0 _ Then Worksheets(2).Cells(3, 874).Value = Worksheets(2).Cells(3, 873).Value Else Sheets(1).Range(Sheets(1).Cells(i, 8 ), Sheets(1).Cells(i, 844)).ClearContents End If Next1: Next i |
Примерно на 70-й возвращённой и снова удалённой строке выскакивает баг (если ClearContents заменить на копи-пэйст значений ячеек пустой строки или же вообще приравниванием нулю, то ошибка всё равно вылезает, только с другим описанием).
Что совсем непонятно, так это то, что просто перевернул вполне работающий код оптимизации через удаление строк, где ошибка, если и вылезает, то после нескольких сотен или тысяч удалённых и заново возвращённых строк:
| Код |
|---|
Sub ExpSel() a = 1589 b = 2940 c = 338 S = 79 m = 4 n = 5 For r = n To n For k = 0 To m - 1 For i = a + k * c To a + (k + 1) * c - 1 Step S If Worksheets(1).Cells(i, 8 ) = 0 _ Then GoTo Next1 If Worksheets(1).Cells(i, 8) > 0 _ Then Worksheets(1).Range(Cells(i, 8), Cells(i, 844)).ClearContents End If Application.Calculate If Worksheets(2).Cells(7, 876) > 0 _ Then Worksheets(2).Cells(3, 874).Value = Worksheets(2).Cells(3, 873).Value Else Worksheets(1).Range(Cells(3173, 8 ), Cells(3173, 844)).Copy Worksheets(1).Range(Cells(i, 8 ), Cells(i, 844)).PasteSpecial Paste:=xlPasteFormulas End If Next1: Next i |
буду благодарен за подсказки решения проблемы
