Я должен запустить свой код несколько раз, чтобы он выполнялся полностью

Question

Я не уверен, что это потому, что я использую ма c или код неправильный, но строки не идентифицируются должным образом и поэтому не удаляются или не вставляются в другую электронную таблицу. Мне нужно выполнить код три раза, чтобы он правильно go прошел через него, скопировал / вставил и удалил ячейки в другую электронную таблицу.

Большое спасибо!

вот код:

Dim j, lastidno As Long


Sheets("Part B + C Modules").Activate
lastidno = Range("A2", Range("A2").End(xlDown)).Count + 1
For j = 2 To lastidno
If Range("O" & j) = "" Then
Sheets("Part B + C Modules").Range("A" & j).Copy
            Sheets("No Options Selected").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("Part B + C Modules").Activate
Rows(j).EntireRow.Delete
End If
Next

MsgBox "done"
End Sub

Answer 1

Итерация и удаление строк выполняется в обратном порядке с использованием отрицательного значения Step> For j = lastidno to 2 Step -1

Однако, похоже, вы можете переписать свой код более элегантно, чтобы избежать:

• Неявные Range ссылки
• Итерация
• Использование Activate или Select

Ключ должен иметь Explicit листовые ссылки для работы с. Также здесь может пригодиться использование SpecialCells для возврата Range за один go (так что больше не будет итераций). Таким образом, вы также можете удалить все строки в одном go!

Ваш код может, например, выглядеть следующим образом:

Sub Test()

'Set up your worksheet variables
Dim ws1 As Worksheet: Set ws1 = Worksheets("Part B + C Modules")
Dim ws2 As Worksheet: Set ws2 = Worksheets("No Options Selected")

'Get last used rows
Dim lr1 As Long: lr1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
Dim lr2 As Long: lr2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row

'Set your range and copy it
Dim rng As Range: Set rng = ws1.Range("O2:O" & lr1).SpecialCells(xlCellTypeBlanks).Offset(0, -14)
rng.Copy ws2.Cells(lr2 + 1, 1)

'Delete your range
rng.EntireRow.Delete

MsgBox "done"

End Sub

Небольшой улов: SpecialCells вернет ошибку, если пустые ячейки не найдены. Возможно, вы захотите обойти это, используя On error или сосчитать пустые ячейки в вашем Range сначала (мои личные предпочтения). Таким образом, указанная c часть может выглядеть следующим образом:

'Set your range and copy it
If WorksheetFunction.CountBlank(ws1.Range("O2:O" & lr1)) > 0 Then
    Dim rng As Range: Set rng = ws1.Range("O2:O" & lr1).SpecialCells(xlCellTypeBlanks).Offset(0, -14)
    rng.Copy ws2.Cells(lr2 + 1, 1)
End If

Еще одна небольшая заметка для справки на будущее: Dim j, lastidno As Long имеет только lastidno, объявленный как Long тип данных. j Переменная автоматически присваивается Variant/Integer, поэтому потенциально может стать проблемой, если ваши данные больше, чем может содержать этот тип данных> Вернуть ошибку OverFlow.