Как исправить ошибку компиляции: Sub или функция не определены в VBA?

Question

Это код, который проходит через ячейки в столбце B в sheet2 .Если он находит значение, которое не является датой в столбце B, то он копирует его, вставляет другой лист с именем «ошибки», а затем удаляет эту строку из Sheet2.Однако всякий раз, когда я пытаюсь выполнить это, я получаю «Ошибка компиляции: Sub или функция не определена».Я видел некоторые другие посты на эту тему, но ничто из упомянутого там не помогло мне.

Sub removeerrors()
Dim i As Range
Dim x As Double
x = Worksheet("Errors").CountA("A1:A100")

    For Each i In Worksheet("Sheet2").Range(Range("A2"), Range("A2").End(xlDown))
        If IsDate(i.Offset(0, 1)) = False Then
            Range(i, i.End(xlToRight)).Copy
            Worksheet("Errors").Range("A1").Offset(x, 0).Paste
            Range(i).EntireRow.Delete
        End If
    Next i
End Sub

Answer 1

Есть несколько других ошибок / изменений, которые могут быть сделаны в скрипте

1. Добавить s в рабочую таблицу
2. Используйте Option Explicit вверху кода
3. Application.WorksheetFunction.CountA
4. Добавить диапазон в качестве аргумента к Counta, т.е. Application.WorksheetFunction.CountA(Worksheets("Errors").Range("A1:A100"))
5. Убедитесь, что с правильными диапазонами работает, включив With Worksheets("Sheet2")
6. Определите последнюю строку, подойдя снизу листа с помощью .Cells(.Rows.Count, "A").End(xlUp).Row, иначе вы можете закончить зацикливанием до нижней части листа
7. Правильный синтаксис для удаляемой строки: i.EntireRow.Delete
8. Вы можете поместить копировальную пасту в одну строку: .Range(i, i.End(xlToRight)).Copy Worksheets("Errors").Range("A1").Offset(x, 0)
9. Остерегайтесь использования End(xlToRight) в случаях возможного попадания в крайний правый угол листа.
10. Оптимизируйте код, отключив некоторые вещи, например, предотвратить перерисовку, отключив обновление экрана во время цикла
11. Соберите диапазоны для удаления с помощью Union и удалите в 1 шаг или цикл назад, чтобы удалить

VBA:

Option Explicit
Public Sub removeerrors()
    Dim i As Range, x As Double, loopRange As Range, lastRow As Long, unionRng As Range
    x = Application.WorksheetFunction.CountA(Worksheets("Errors").Range("A1:A100"))
    Application.ScreenUpdating = False
    With Worksheets("Sheet2")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set loopRange = .Range("A2:A" & lastRow)
        If lastRow = 1 Then Exit Sub
        For Each i In loopRange
            If Not IsDate(i.Offset(0, 1)) Then
                .Range(i, i.End(xlToRight)).Copy Worksheets("Errors").Range("A1").Offset(x, 0)
                If Not unionRng Is Nothing Then
                    Set unionRng = Union(unionRng, i)
                Else
                    Set unionRng = i
                End If
            End If
        Next i
    End With
    If Not unionRng Is Nothing Then unionRng.EntireRow.Delete
    Application.ScreenUpdating = True
End Sub

Answer 2

использовать полные ссылки на диапазон

цикл при удалении строк

обновить индекс строки вставки целевого листа

следующим образом

Option Explicit

Sub removeerrors()
    Dim iRow As Long
    Dim x As Double
    x = Worksheets("Errors").CountA("A1:A100")

    With Worksheets("Sheet2") ' referecne "Sheet2" sheet
        With .Range(.Range("A2"), .Range("A2").End(xlDown))  ' reference referenced sheet range from cell A2 down to next not empty one
            For iRow = .Rows.Count To 1 Step -1 ' loop reference range backwards from its last row up
                If Not IsDate(.Cells(iRow, 2)) Then ' if referenced range cell in column B current row is not a date
                    .Range(.Cells(iRow, 1), .Cells(iRow, 1).End(xlToRight)).Copy Destination:=Worksheets("Errors").Range("A1").Offset(x, 0) ' copy referenced range current row spanning from column A to next not empty column and paste it to sheet "Errors" column A row x
                    x = x + 1 ' update offset
                    .Rows(1).EntireRow.Delete ' delete referenced range current row
                End If
            Next
        End With
    End With
End Sub

Answer 3

Вам просто нужно изменить Worksheet на Worksheets с 's' в конце.

Sub removeerrors()
Dim i As Range
Dim x As Double
x = Worksheets("Errors").CountA("A1:A100")

    For Each i In Worksheets("Sheet2").Range(Range("A2"), Range("A2").End(xlDown))
        If IsDate(i.Offset(0, 1)) = False Then
            Range(i, i.End(xlToRight)).Copy
            Worksheets("Errors").Range("A1").Offset(x, 0).Paste
            Range(i).EntireRow.Delete
        End If
    Next i
End Sub