nilem, Доброго времени суток! После подробного изучения Вашего макроса возник вопросец: а возможно ли считать данные с двух идентичных по своей структуре но с разными данными листов в один массив, или объеденить два массива в один - а потом уже сним работать? т.е. в принципе как в примере: Нужно собрать данные с листа1 и листа2 из ячеек выделенных синим и заполнить взятыми значениями лист3 ячеки выделенные красным.
nilem, Доброго времени суток! После подробного изучения Вашего макроса возник вопросец: а возможно ли считать данные с двух идентичных по своей структуре но с разными данными листов в один массив, или объеденить два массива в один - а потом уже сним работать? т.е. в принципе как в примере: Нужно собрать данные с листа1 и листа2 из ячеек выделенных синим и заполнить взятыми значениями лист3 ячеки выделенные красным.Ed_Vard
Скорее всего можно, только непонятно, по каким условиям должен заполняться красный диапазон: совпадение по Рег.Номеру или №пачки и т.п. Или просто объединить 2 листа - тогда проще скопировать.
Скорее всего можно, только непонятно, по каким условиям должен заполняться красный диапазон: совпадение по Рег.Номеру или №пачки и т.п. Или просто объединить 2 листа - тогда проще скопировать.nilem
Скорее всего можно, только непонятно, по каким условиям должен заполняться красный диапазон: совпадение по Рег.Номеру или №пачки и т.п. Или просто объединить 2 листа - тогда проще скопировать.
Сам макрос я написал - но только он собирает с одного листа - на основе Вашего макроса! Можно его применить для каждого листа в отдельности - но при обработке одного в листе назначения удаляються результаты работы другого ! Поэтому и возникла идея в из двух собрать в один - а потом уже обрабатывать! Выборка идет по столбцу Н. Поторопился - что то как то непонятно происходит работа макроса. берет тока одно значение. вот так выглядит он у меня:
Code
Option Explicit
Sub proba() Dim x, y, z(), u(), i As Long, k As Long Application.ScreenUpdating = False
y = Range([h2], Cells(Rows.Count, 8).End(xlUp)).Value 'на лист3 With Sheets("лист1") 'на лист1 x = .Range("h2:s" & .Cells(Rows.Count, 8).End(xlUp).Row).Value End With
ReDim z(1 To UBound(y), 1 To 12)
With CreateObject("Scripting.Dictionary") 'Dictionary может содержать только уник. элементы For i = 1 To UBound(y): .Item(y(i, 1)) = i: Next i 'заполняем из лист3
For i = 1 To UBound(x) 'Перебираем лист1 If Len(x(i, 1)) > 0 Then 'на всякий случай If .Exists(x(i, 1)) Then 'если попался неуникальный РегНомер, записываем его в Анализ k = .Item(x(i, 1)) 'номер строки z(k, 1) = x(i, 8): z(k, 2) = x(i, 9) 'переносим из EFGH 1-го полугодия z(k, 3) = x(i, 10): z(k, 4) = x(i, 11) 'в OPQR лист3 z(k, 5) = x(i, 12) End If End If Next i End With
Range("o2:s2" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents [o2:s2].Resize(i).Value = z
Application.ScreenUpdating = True End Sub
Quote (nilem)
Скорее всего можно, только непонятно, по каким условиям должен заполняться красный диапазон: совпадение по Рег.Номеру или №пачки и т.п. Или просто объединить 2 листа - тогда проще скопировать.
Сам макрос я написал - но только он собирает с одного листа - на основе Вашего макроса! Можно его применить для каждого листа в отдельности - но при обработке одного в листе назначения удаляються результаты работы другого ! Поэтому и возникла идея в из двух собрать в один - а потом уже обрабатывать! Выборка идет по столбцу Н. Поторопился - что то как то непонятно происходит работа макроса. берет тока одно значение. вот так выглядит он у меня:
Code
Option Explicit
Sub proba() Dim x, y, z(), u(), i As Long, k As Long Application.ScreenUpdating = False
y = Range([h2], Cells(Rows.Count, 8).End(xlUp)).Value 'на лист3 With Sheets("лист1") 'на лист1 x = .Range("h2:s" & .Cells(Rows.Count, 8).End(xlUp).Row).Value End With
ReDim z(1 To UBound(y), 1 To 12)
With CreateObject("Scripting.Dictionary") 'Dictionary может содержать только уник. элементы For i = 1 To UBound(y): .Item(y(i, 1)) = i: Next i 'заполняем из лист3
For i = 1 To UBound(x) 'Перебираем лист1 If Len(x(i, 1)) > 0 Then 'на всякий случай If .Exists(x(i, 1)) Then 'если попался неуникальный РегНомер, записываем его в Анализ k = .Item(x(i, 1)) 'номер строки z(k, 1) = x(i, 8): z(k, 2) = x(i, 9) 'переносим из EFGH 1-го полугодия z(k, 3) = x(i, 10): z(k, 4) = x(i, 11) 'в OPQR лист3 z(k, 5) = x(i, 12) End If End If Next i End With
Range("o2:s2" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents [o2:s2].Resize(i).Value = z
Вот, смотрите Модуль3 Sub psb() В этом случае можно сделать проще (правда, будет выбиваться из общей картины, но в познавательных целях можно ) , позже нарисую.
Вот, смотрите Модуль3 Sub psb() В этом случае можно сделать проще (правда, будет выбиваться из общей картины, но в познавательных целях можно ) , позже нарисую.nilem