VBA - некоторые данные видны только после второго запуска

Question

Этот код ниже выполняет следующие действия:

1. Копирует определенные строки из листа "source"
2. Вставляет строки в лист "target"
3. Имеет ли счет«типов» (столбец E) и вставляет счет в столбец J

У меня проблема в шаге 3. Предполагается, что макрос будет:

1. Столбец I, строки 3 - 5 -> Вставить заголовки столбцов «Дефект», «Система», «Сценарий»
2. Выполнить функцию CountIf столбца E для каждого критерия в столбце I
3. Выведите значение (подсчитанное число) в столбце J в соответствующих строках рядом со столбцом I

Например:

• Столбец I, строка 3 -> Дефект
• Столбец J, строка 3 -> Количество случаев, когда "Дефект" встречается в столбце E

Однако, похоже, происходит следующее:

1. Столбец I заполняется правильными критериями
2. CountIf выполняется (что представляется правильным) и вставляет значения в Column J
3. При вставке значений критерии в столбце I стираются, и все, что у меня осталось, это числовые значения в столбце J

Теперь, если я запускаю макрос в секундувремя, затем он работает, как ожидалось, и я не могу понять, почему.

Кроме того, в столбце E нет записей «Дефект», поэтому значение равно 0. Но при первом запуске вы не видите 0Это просто пусто.При втором запуске отображается значение 0.

Sub Copy()

    Dim xRg As Range, xCell As Range
    Dim i As Long, J As Long, K As Long, x As Long, count As Long
    Dim y As Workbook
    Dim ws1 As Worksheet
    Dim element As Variant, myarray As Variant

    myarray = Array("Defect", "System", "Script")

    i = Worksheets("source").UsedRange.Rows.count
    J = Worksheets("target").UsedRange.Rows.count

    count = 3

    Set y = Workbooks("myWKBK.xlsm")

    Set ws1 = y.Sheets("target")

    If J = 1 Then

        If Application.WorksheetFunction.CountA(Worksheets("target").UsedRange) = 0 Then J = 0

    End If

    lngLastRow = Cells(Rows.count, "C").End(xlUp).Row

    Set xRg = Worksheets("source").Range("E3:E" & lngLastRow & i)

    On Error Resume Next
    Application.ScreenUpdating = False

    With ws1

        'Assign name to columns where values will be pasted
        .Range("$B$2").Value = "ID"
        .Range("$C$2").Value = "Status"
        .Range("$D$2").Value = "Description"
        .Range("$E$2").Value = "Type"
        .Range("$F$2").Value = "Folder"
        .Range("$G$2").Value = "Defect ID"
        .Range("$I$2").Value = "Type"
        .Range("$I$3").Value = "Defect"
        .Range("$I$4").Value = "System"
        .Range("$I$5").Value = "Script"
        .Range("$J$2").Value = "Count"

    End With

    For Each element In myarray

        For K = 1 To xRg.count

            If CStr(xRg(K).Value) = element Then

                LastRow = ws1.Cells(Rows.count, "B").End(xlUp).Row + 1
                xRg(K).EntireRow.Copy Destination:=ws1.Range("A" & LastRow)

                J = J + 1

            End If

        Next

        x = Range("E" & Rows.count).End(xlUp).Row

        Range("J" & count) = Application.WorksheetFunction.CountIf(Range("E3:E" & x), element)

        count = count + 1

    Next element

    ws1.Columns("B:J").AutoFit

    Application.ScreenUpdating = True

End Sub

РЕДАКТИРОВАТЬ:

Вероятно, стоит упомянуть, что приведенный ниже подпунктСам по себе работает просто отлично:

Sub CountIf()

    Dim element As Variant
    Dim myarray As Variant

    myarray = Array("Defect", "System", "Script")

    Dim count As Long

    count = 3

    For Each element In myarray

        Dim x As Long
        x = Range("E" & Rows.count).End(xlUp).Row
        Range("J" & count) = Application.WorksheetFunction.CountIf(Range("E3:E" & x), element)

        count = count + 1

    Next element

End Sub

Эта функция выполняет CountIf только самостоятельно и работает точно так, как ожидается.

Answer 1

Это действительно красивая часть вашего кода:

Set xRg = Worksheets("source").Range("E3:E" & lngLastRow & i)

Он правильно устанавливает родительский лист объекта Range, поэтому VBA знает, где искать.Однако по ряду причин это не всегда так.Взгляните на эти строки:

lngLastRow = Cells(Rows.count, "C").End(xlUp).Row
x = Range("E" & Rows.count).End(xlUp).Row
Range("J" & count) = Application.WorksheetFunction.CountIf(Range("E3:E" & x), element)

, где лист не задан.Таким образом, он принимает либо ActiveSheet, либо рабочий лист, в котором находится код (если он находится на рабочем листе, а не в модуле).Попробуйте переписать его, следуя красивой части вашего кода, например, определив лист:

With Worksheet("SomeName")
    lngLastRow = .Cells(Rows.count, "C").End(xlUp).Row
    x = .Range("E" & Rows.count).End(xlUp).Row
    .Range("J" & count) = Application.WorksheetFunction.CountIf(Range("E3:E" & x), element)
End With

---

В качестве следующего шага отладки попробуйте удалить On Error Resume Next, поскольку он игнорирует ошибкив приложениях и может привести к ложным результатам из-за этого.