копирование и вставка данных в заданном порядке

[Dog_DinGo]

не не не, ночь не для сна у меня, ну по крайней мере, первая её полвоина...

я тут небольшую релаксацию провёл.. в общем не важно...

IgorGo прав, я выбрал тот вариант, который прост мне для понимания...
В придачу этот отчёт мой первый проект.. и то стал изучать VBA для облегчения своей работы.... плюс возникеат трудность, что на работе стоит опенофис, поэтому не все макросы вба там работают... а старбейсик начал изучать и понял, что там мне будет очень сложно изучить... с вба по проще, почитал Уокенбаха и начал делать...

и для меня, что проще глазу воспринимается, то и проще...

анализ будет происходить из положительных чисел... не буду вдоваться в подробности... но вероятность того, что число будет отрицательным равна 99 процентам...

Hugo121, если тебе не нравиться громозкое или... какой вариант ты бы предпочёл? =)

[Hugo121]

Ну если возможны отричательные - тогда на сумму проверять нельзя, разве что абсолютные значения суммировать - но это только утяжелит код.
Делайте с OR, но с WITH - так чуть букв поменьше.

[Dog_DinGo]

оставляю как есть...

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

сумма ускорит код? или будет это на столько не значительно, что не стоит заморачиваться?

[SAS888]

сумма ускорит код? или будет это на столько не значительно, что не стоит заморачиваться?

У Вас в цикле проверяются условия и копируются ячейки. Вркмя процедуры проверки условий занимает примерно 2...4 процента от времени копирования. Поэтому, в данном случае, метод проверки условий практически не повлияет на скорость выполнения макроса в целом.
Если же Вы хотите ускорить процесс, то непосредственную работу с ячейками листа нужно минимизировать.
Так, например, следующий макрос будет работать примерно в 250 раз быстрее (в зависимости от количества копируемых ячеек):

Sub Main()
    Dim i As Integer, a(), b(): Application.ScreenUpdating = False
    a = Sheets("ОТЧЁТ").[A9:M80].Value: ReDim b(1 To UBound(a, 1), 1 To 1)
    For i = 1 To UBound(a, 1)
        If a(i, 2) <> 0 And a(i, 7) <> 0 And a(i, 10) <> 0 And a(i, 13) <> 0 Then b(i, 1) = a(i, 1)
    Next: [A9].Resize(UBound(b, 1)).Value = b
End Sub

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

[Hugo121]

При таком небольшом количестве проверок особой разницы нет, как проверять.
Если замерить например 1000 прогонов этого цикла - тогда уже будет видна разница.
Я тут на досуге тоже подобрал ещё два варианта - первый это перебор массива, как предложил SAS888 (только вместо And нужно Or), другой - проверять строку другим циклом For Each и при первом совпадении выходить из этого цикла. Так не будут всегда проверяться все 4 ячейки.
Можно это совместить - перебор массива в массиве
Но на 79*4 проверки заметной разницы не будет при любом способе.
P.S. При выгрузке массива в [A9]
[A9].Resize(UBound(b, 1)).Value = b
затрутся все возможно находящиеся в этом диапазоне формулы. Так что такой способ не всегда подходит.
Но всё равно можно комбинировать - проверять в массиве, а копировать ячейки. Это всё равно будет быстрее, чем всё делать на листе.
PP.S. Я как-то раз замерял скорость перебора ячеек листа и этих же ячеек, перекинутых в массив. Разница по скорости получилась в 38 раз - вроде кажется немного, но если код с Cells(x,y) работает полчаса - значит на массиве отработает быстрее минуты.
Но как-то на другом форуме один код ускорился с 40 минут до 5 секунд

[Hugo121]

Потестил разные подходы - по 1000 циклов, без операции копирования, только сравнение.
Результаты:
OR: 4.453125 - 11000
SUM: 3.34375 - 11000
SUM_Arr: 1 - 11000
OR_2Arr: 0.203125 - 11000
Итого - ускорилось в 22 раза.
11000 - это количество найденных строк, чтоб видеть, что отработало одинаково.

Sub test()
ProrisovkaFO
ProrisovkaFO_Sum
ProrisovkaFO_SumArr
ProrisovkaFO_OR2Arr
End Sub

Sub ProrisovkaFO()
'Sheets.Add
'j = ActiveSheet.Name
'Worksheets(j).Name = "TEST"
Dim tm
tm = Timer
For ttt = 1 To 1000
For i = 9 To 80
If Worksheets("ОТЧЁТ").Cells(i, 2) <> 0 Or Worksheets("ОТЧЁТ").Cells(i, 7) <> 0 _
Or Worksheets("ОТЧЁТ").Cells(i, 10) <> 0 Or Worksheets("ОТЧЁТ").Cells(i, 13) <> 0 Then _
x = x + 1 'Worksheets("ОТЧЁТ").Cells(i, 1).Copy Worksheets("TEST").Cells(i, 1)
Next i, ttt
tm = Timer - tm

Debug.Print "OR: " & tm & " - " & x
End Sub

Sub ProrisovkaFO_Sum()
'Sheets.Add
'j = ActiveSheet.Name
'Worksheets(j).Name = "TEST"
Dim tm
tm = Timer
With Worksheets("ОТЧЁТ")
For ttt = 1 To 1000
For i = 9 To 80
If Application.Sum(.Cells(i, 2), .Cells(i, 7), .Cells(i, 10), .Cells(i, 13)) > 0 Then x = x + 1 'Worksheets("ОТЧЁТ").Cells(i, 1).Copy Worksheets("TEST").Cells(i, 1)
Next i, ttt
End With
tm = Timer - tm

Debug.Print "SUM: " & tm & " - " & x
End Sub

Sub ProrisovkaFO_SumArr()
'Sheets.Add
'j = ActiveSheet.Name
'Worksheets(j).Name = "TEST"
Dim tm
tm = Timer
Dim a
With Worksheets("ОТЧЁТ")
For ttt = 1 To 1000
a = .[B9:M80]
For i = 1 To 72
If Application.Sum(a(i, 1), a(i, 6), a(i, 9), a(i, 12)) > 0 Then x = x + 1 'Worksheets("ОТЧЁТ").Cells(i, 1).Copy Worksheets("TEST").Cells(i, 1)
Next i, ttt
End With
tm = Timer - tm

Debug.Print "SUM_Arr: " & tm & " - " & x
End Sub

Sub ProrisovkaFO_OR2Arr()
'Sheets.Add
'j = ActiveSheet.Name
'Worksheets(j).Name = "TEST"
Dim tm
tm = Timer
Dim a
Dim b, xx
b = Array(1, 6, 9, 12)

With Worksheets("ОТЧЁТ")
For ttt = 1 To 1000
a = .[B9:M80]
For i = 1 To 72
For Each xx In b
If a(i, xx) <> 0 Then x = x + 1: Exit For
Next
Next i, ttt
End With
tm = Timer - tm

Debug.Print "OR_2Arr: " & tm & " - " & x
End Sub

[SAS888]

Hugo121
1. То, что вместо AND нужно OR - естественно. Прошу прощения за "описку".
2. То, что копирование ячейки рабочего листа в цикле занимает в сотни раз больше времени, чем один раз сформировать массив и один раз его вставить на лист - это тоже не обсуждается.
3. По поводу "затирки" имеющихся значений на листе: во-первых, такой задачи не было, во-вторых, можно массив b (из моего кода) формировать не пустой, а из имеющихся значений на итоговом листе (естественно, предварительно определив предельное значение размерности), а затем, если соблюдаются условия сравнения, заменять текущее значение этого массива (нужно пример?).
4. Решение данной задачи с использованием массивов, даст выигрыш по скорости в сотни раз (ну, не Вам это объяснять). А по поводу того, как оптимизировать процедуру сравнения, то при

...таком небольшом количестве проверок...

я не заморачивался. Т.к. сравнений мало, то я предпочел оптимизировать количество строк кода.

[Hugo121]

Да всё понятно, какие споры...
Вот только хочу уточнить для сторонних наблюдателей обсуждения (133 просмотра на сейчас) по поводу "затирки" имеющихся значений - можно взять в массив с листа, но возмутся значения, а не формулы, и выгрузятся назад тоже уже значения.
Допустим, на листе чередуются ячейки под значения с ячейками с формулами.
Нам нужно подтянуть/скопировать из другого листа значения на отведённые места - тогда одним массивом делать нельзя. Или копировать отдельные значения ячеек, или заводить столько массивов, сколько областей под значения, и выгружать именно на эти места, не трогая формулы.
Такое бывает, делал...

[SAS888]

Такое бывает, делал...

Вот это да!!!!! А откуда формулы знают, что на их строке соседнего листа не выполнятся условия? Т.е. те ячейки, которые удовлетворяют условиям сравнения будут содержать значения, а те, для которых условия не выполняются, возможно, будут содержать формулы? Это же "винегрет". К тому же, автор вообще применяет метод копирования ячеек, что в принципе, для ячеек с формулами не подойдет. Даже, если такое чудо возможно, то от этого нужно уйти (я не пытаюсь с Вами спорить, это чисто мое личное мнение).

[Hugo121]

Ну как - допустим на листе есть две таблицы с значениями (одна над другой, не рядом), ниже подбит по каждой итог формулой. Такое бывает?
Далее нужно в эти таблицы закинуть числа из другого листа по некоему признаку например столбца А. Такое бывает?
Ну вот Вам и необходимость двух массивов... Или двух макросов. Или копировать поячеечно.