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

[sn00p]

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

Небольшое уточнение: оператор ReDim Preserve может изменять лишь величину последней размерности в n-мерном массиве. поэтому, если, например, требуется изменить 1-ю размерность в 2-мерном массиве (количество строк), то потребуется транспонировать этот массив, применять ReDim Preserve, затем вновь транспонировать. К тому же, этот оператор не только изменяет размерность, но и перезаписывает заново все элементы массива. Так что применять его в цикле нецелесообразно.
На мой взгляд, если это, конечно, возможно, лучше сначала выявить все строки массива, которые требуется удалить, а уже затем сформировать новый, требуемый массив, что будет существенно быстрее, нежели каждый раз перебирать исходный массив, тем более использовать ReDim Preserve.

гуманно, так и сделаю!
спасибо за совет!код вывалю потом

[nilem]

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

а если 17 000 строк? на сколько быстро сработает метод?

Попробуйте:

Sub test2()
Dim x, tm As Single
tm = Timer
x = Range("A1:H" & Cells(Rows.Count, 1).End(xlUp).Row).Value
'удаляем из массива 9-ю строку
x = DelRow(x, 9)
MsgBox Timer - tm: tm = Timer
[j1].Resize(UBound(x, 1), UBound(x, 2)).Value = x
MsgBox Timer - tm
End Sub

У меня перезапись массива на 17000 строк заняла 0,14 сек, вывод на лист 0,89 сек (комп старый на работе).

[SAS888]

У меня перезапись массива на 17000 строк заняла 0,14 сек, вывод на лист 0,89 сек (комп старый на работе).

nilem, Ваша функция удаляет 1 строку массива. Но, если автору потребуется применять эту функцию в какой-то своей, более крупной процедуре, и если в этой процедуре потребуется применять предложенную функцию несколько тысяч (может десятков тысяч) раз, то не сложно подсчитать затрачиваемое время.
Не лучше ли (повторюсь, что если это применимо к конкретной задаче), формировать новый массив 1 раз, заранее определив, какие строки он должен (или не должен) содержать?

[nilem]

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

Не лучше ли (повторюсь, что если это применимо к конкретной задаче), формировать новый массив 1 раз, заранее определив, какие строки он должен (или не должен) содержать?

Согласен, конечно лучше. Мой подход применим для, может быть, десятка строк. Если речь о тысячах записей, то так не пойдет.

[sn00p]

Да, все верно, у меня в таблице из более 17000 строк остается 10к строк, поэтому написание ф-ии по удалению одной строки не практично, но тем не менее спасибо.

'можно назвать удалением строк массива, путем копирования в
'другой массив, более 17000 строк отрабатывает менее чем за секунду.
'алгоритм может и корявый, сильно не пинайте я не профи), но критику принимаю с благодарностью
'но работает быстро и как надо

'самописная ф-ия возвращает кол-во не пустых строк в таблице
nLastrow = iHowStr("сличительная")
'самописная ф-ия возвращает кол-во не пустых столбцов в таблице
nLastCol = iHowCol("сличительная")


Dim sekkk
'вставляем в массив данные с листа
sekkk = ActiveWorkbook.Worksheets("сличител ьная").Range("a1:j" & nLastrow)
'растягиваем массив до нужного размера
ReDim Preserve sekkk(1 To UBound(sekkk), 1 To nLastCol)
'
For i = 1 To nLastrow
'считаем кол-во строк конечного массива , в соответствии с нужным нам условием
If sekkk(i, 6) <> 0 And sekkk(i, 8) <> 0 Then nKolZeroRow = nKolZeroRow + 1
'End If
Next i

'создаем конечный массив нужного нам размера
Dim se22
ReDim se22(1 To nKolZeroRow, 1 To nLastCol)
'перебор начального массива
For i = 1 To nLastrow
'выбор нужных значений и перенос их итоговый массив
If sekkk(i, 6) <> 0 And sekkk(i, 8) <> 0 Then
nRowNum = nRowNum + 1
se22(nRowNum, 1) = sekkk(i, 1)
se22(nRowNum, 2) = sekkk(i, 2)
se22(nRowNum, 3) = sekkk(i, 3)
se22(nRowNum, 4) = sekkk(i, 4)
se22(nRowNum, 5) = sekkk(i, 5)
se22(nRowNum, 6) = sekkk(i, 6)
se22(nRowNum, 7) = sekkk(i, 7)
se22(nRowNum, 8) = sekkk(i, 8)
se22(nRowNum, 9) = sekkk(i, 9)
se22(nRowNum, 10) = sekkk(i, 10)
se22(nRowNum, 11) = sekkk(i, 11)
End If
Next i
'вставляем итоговые данные на лист
ActiveWorkbook.Worksheets("лист2"). Range("a1").Resize(nKolZeroRow, nLastCol).Value = se22

[SAS888]

На сколько я понял из Вашего кода, Вам требуется перенести на лист "Лист2" все строки листа "сличительная" в диапазоне столбцов "A:J", в которых значения в 6-м или 8-м столбцах не равны 0. Так? Если так, то все можно сделать существенно проще и гораздо быстрее, если использовать встроенные методы Excel, обойтись вообще без циклов и формирования массивов:

Sub test()
    Dim se22(): Application.ScreenUpdating = False
    With ActiveWorkbook.Sheets("сличительная")
        .[A:J].AutoFilter: .[A:J].AutoFilter Field:=6, Criteria1:="<>0"
        .[A:J].AutoFilter Field:=8, Criteria1:="<>0"
        With .AutoFilter.Range
            .Resize(.Rows.Count).SpecialCells(xlVisible).EntireRow.Copy ActiveWorkbook.Sheets("Лист2").Rows(1)
    End With: .[A:J].AutoFilter: End With
End Sub

Пример использования во вложении. Запустите макрос "test" при любом активном листе.

[sn00p]

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

На сколько я понял из Вашего кода, Вам требуется перенести на лист "Лист2" все строки листа "сличительная" в диапазоне столбцов "A:J", в которых значения в 6-м или 8-м столбцах не равны 0. Так? Если так, то все можно сделать существенно проще и гораздо быстрее, если использовать встроенные методы Excel, обойтись вообще без циклов и формирования массивов:

Sub test()
    Dim se22(): Application.ScreenUpdating = False
    With ActiveWorkbook.Sheets("сличительная")
        .[A:J].AutoFilter: .[A:J].AutoFilter Field:=6, Criteria1:="<>0"
        .[A:J].AutoFilter Field:=8, Criteria1:="<>0"
        With .AutoFilter.Range
            .Resize(.Rows.Count).SpecialCells(xlVisible).EntireRow.Copy ActiveWorkbook.Sheets("Лист2").Rows(1)
    End With: .[A:J].AutoFilter: End With
End Sub

Пример использования во вложении. Запустите макрос "test" при любом активном листе.

вы мой КУМИР!))))
все гениальное просто))!!!
я только учусь)....
спасибо!

хотя отрабатывает подольше, порядка 2х секунд

[Hugo121]

sn00p, Ваш код ещё можно немного ускорить, откинув ненужную проверку в этой строке (в двух местах в коде):
If sekkk(i, 6) <> 0 And sekkk(i, 8) <> 0 Then
Это нужно заменить на
If sekkk(i, 6) <> 0 Then
If sekkk(i, 8) <> 0 Then
Тогда при несовпадении первого условия второе проверяться не будет.
И вот что-то я не понял, зачем sekkk растягивать, раз ничего туда не помещаете?

И можно было упростить код, просто создав другой массив аналогичного размера (не высчитывая в начале нужный будущий размер), затем переложить в него нужные строки (низ массива пусть остаётся пустым), затем выгрузить только верхушку, ведь её размер известен в переменной nRowNum.

[SAS888]

И можно было упростить код, просто создав другой массив аналогичного размера (не высчитывая в начале нужный будущий размер), затем переложить в него нужные строки (низ массива пусть остаётся пустым), затем выгрузить только верхушку, ведь её размер известен в переменной nRowNum.

+1. Если использовать массивы, то так и нужно делать. Более того, если выгружать только "верхушку", то будет быстрее. А если не "обрезать" массив, то своими пустыми значениями он затрет возможно уже имеющиеся на листе данные, и Вам не понадобится предварительная очистка листа.

[sn00p]

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

sn00p, Ваш код ещё можно немного ускорить, откинув ненужную проверку в этой строке (в двух местах в коде):
If sekkk(i, 6) <> 0 And sekkk(i, 8) <> 0 Then
Это нужно заменить на
If sekkk(i, 6) <> 0 Then
If sekkk(i, 8) <> 0 Then
Тогда при несовпадении первого условия второе проверяться не будет.

Хорошо, учту!

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

И вот что-то я не понял, зачем sekkk растягивать, раз ничего туда не помещаете?

ну тем самым я подготовил массив нужного мне размера и потом уже начал его заполнять..или так не делается? и можно сразу его начать заполнять строками?

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

И можно было упростить код, просто создав другой массив аналогичного размера (не высчитывая в начале нужный будущий размер), затем переложить в него нужные строки (низ массива пусть остаётся пустым), затем выгрузить только верхушку, ведь её размер известен в переменной nRowNum.

то же верно

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