удалить стороку в массиве

[Hugo121]

Про
ReDim Preserve sekkk(1 To UBound(sekkk), 1 To nLastCol)
Что-то я не вижу, где Вы его потом заполняете. Вижу, что читаете. Причём вроде только прежний размер, а новую часть не трогаете.
А заполнили ведь его уже выше:
sekkk = ActiveWorkbook.Worksheets("сличител ьная").Range("a1:j" & nLastrow)

[sn00p]

да??....вот жежжжж...
ну это тогда у меня давнишняя ошибка, кто то как пример мне дал такую связку
sekkk = ActiveWorkbook.Worksheets("сличител ьная").Range("a1:k" & nLastrow)
ReDim Preserve sekkk(1 To UBound(sekkk), 1 To nLastCol)
вот я ее и юзаю...

[SAS888]

Ну, в общем, где-то так:

Sub qq()
    Dim i As Long, j As Long, k As Integer, a(), b(): Application.ScreenUpdating = False
    a = ActiveWorkbook.Sheets("сличительная").Range("A1:J" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2)): j = 1
    For i = 1 To UBound(a, 1)
        If a(i, 6) <> 0 Then
            If a(i, 8) <> 0 Then
                For k = 1 To UBound(b, 2): b(j, k) = a(i, k): Next
                j = j + 1
    End If: End If: Next
    ActiveWorkbook.Sheets("Лист2").[A1].Resize(j, UBound(b, 2)).Value = b
End Sub

[Hugo121]

Значит можно сэкономить ещё 0,14 сек
P.S. Пока писал, уже сэкономили
Всё так и есть - без ReDim Preserve, без лишней проверки, выгружается только верхушка.

[SAS888]

Значит можно сэкономить ещё 0,14 сек

По сравнению с чем?

[Hugo121]

Сообщение от SAS888

По сравнению с чем?

Это я писал до Вашего кода (долго писал )
А 0,14 сек отрабатывал код nilemа по перерисовке массива на 17000 записей (где-то на 2-ой странице).

[sn00p]

погорячился)

[sn00p]

само условие неверное , мне нужно удалять лишь только в том случае, когда оба значения =0

[Hugo121]

Значения цифры? Проверяйте сумму (если нет вариантов "+ на - дают 0").
If (a(i, 6) + a(i, 8)) <> 0 Then

[sn00p]

хорошо, спасибо, а то я уже голову сломал какой цикл использовать