Есть 3 вложенных цикла, типа For n=1 To X ..... Next n. Они запускаются по нажатию кнопки на Лист 1. 1 цикл - перебор ячеек, по столбцам, в определенной строке, Лист 1 2 цикл, вложенный - перебор ячеек, по столбцам, в определенной строке, Лист 2 3 цикл, вложенный - Если ячейки в Лист 1 и Лист 2 совпали - в Лист 1, в совпавшей колонке, ниже, ячейка заполняется данными из Лист 2. Сделал как мог, но коряво... [vba]
Код
With Sheets("Sheet1"): iLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row: End With 'EndCell, лист для заполнения With Sheets("Sheet1"): iEndCol = .UsedRange.Columns.Count: End With 'Последний столбец With Sheets("ПК"): lLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row: End With 'EndCell,источник лист для копирования With Sheets("ПК"): lEndCol = .UsedRange.Columns.Count: End With 'Последний столбец
For j = 2 To iEndCol ' По столбцам лист1 For i = 2 To lEndCol ' По столбцам лист2 For n = iLastRow + 1 To lLastRow '+ iLastRow ' c последней пустой, цикл по ячейкам If StrComp(Sheets("Sheet1").Cells(iLastRow, j), Sheets("ПК").Cells(1, i), vbTextCompare) = 0 Then 'если ячейки в колонке совпали Sheets("Sheet1").Cells(n, j).Value = Sheets("ПК").Cells(n, j) ' копируем ячейки построчно, поколоночно, в той колонке что совпала 'Sheets("Sheet1").Cells(n, 1).Value = Sheets("ПК").Cells(n, 1) ' ставим Unique_Id в 1 столбец 'MsgBox j & "=" & i & "=" & " = " & n Else Exit For ' совпадения нет-выходим из цикла End If Next n Next i Next j
[/vba] Если количество проверяемых столбцов не совпадает - данные "плывут" по столбцам и строкам.
Как правильно организовать циклы - что бы несовпадающие столбцы(в первых двух циклах) не влияли на вставку данных в Лист 1? Может, нужен другой подход?
Есть 3 вложенных цикла, типа For n=1 To X ..... Next n. Они запускаются по нажатию кнопки на Лист 1. 1 цикл - перебор ячеек, по столбцам, в определенной строке, Лист 1 2 цикл, вложенный - перебор ячеек, по столбцам, в определенной строке, Лист 2 3 цикл, вложенный - Если ячейки в Лист 1 и Лист 2 совпали - в Лист 1, в совпавшей колонке, ниже, ячейка заполняется данными из Лист 2. Сделал как мог, но коряво... [vba]
Код
With Sheets("Sheet1"): iLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row: End With 'EndCell, лист для заполнения With Sheets("Sheet1"): iEndCol = .UsedRange.Columns.Count: End With 'Последний столбец With Sheets("ПК"): lLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row: End With 'EndCell,источник лист для копирования With Sheets("ПК"): lEndCol = .UsedRange.Columns.Count: End With 'Последний столбец
For j = 2 To iEndCol ' По столбцам лист1 For i = 2 To lEndCol ' По столбцам лист2 For n = iLastRow + 1 To lLastRow '+ iLastRow ' c последней пустой, цикл по ячейкам If StrComp(Sheets("Sheet1").Cells(iLastRow, j), Sheets("ПК").Cells(1, i), vbTextCompare) = 0 Then 'если ячейки в колонке совпали Sheets("Sheet1").Cells(n, j).Value = Sheets("ПК").Cells(n, j) ' копируем ячейки построчно, поколоночно, в той колонке что совпала 'Sheets("Sheet1").Cells(n, 1).Value = Sheets("ПК").Cells(n, 1) ' ставим Unique_Id в 1 столбец 'MsgBox j & "=" & i & "=" & " = " & n Else Exit For ' совпадения нет-выходим из цикла End If Next n Next i Next j
[/vba] Если количество проверяемых столбцов не совпадает - данные "плывут" по столбцам и строкам.
Как правильно организовать циклы - что бы несовпадающие столбцы(в первых двух циклах) не влияли на вставку данных в Лист 1? Может, нужен другой подход?alexban65
Активный лист - Лист 1. В Лист 1, в строке=2, в ячейках содержатся имена. В Лист 2, в строке=1, в ячейках содержатся имена. Имена в Лист 1 и Лист 2 - сравниваются циклами по столбцам, используем в каждом цикле Cells(x,y). Если Ячейка.Лист1 совпали Ячейка.Лист2( то тогда совпали и номера столбцов сравниваемых ячеек). Тогда на Лист1 запускается цикл копирования ячеек строки из Лист 2. Стартовый адрес копируемых ячеек(Источник) Лист2.Cells(2, номер столбца совпавший) Адрес назначения Лист1.Cells(3, номер столбца совпавший). Операция повторяется пока все ячейки Лист2 не будут скопированы в Лист1 по соответствующим ячейкам. [vba]
Код
То есть кратко-данные из Лист2 скопировать в Лист1 по условию Лист1.Ячейка=Лист2.Ячейка: Старт: если sheets(Лист1).Cell(2,2)=sheets(Лист2).Cell(1,2) To (Лист1).Cell(3,2) <-- (Лист2).Cell(2,2) если sheets(Лист1).Cell(2,3)=sheets(Лист2).Cell(1,3) To (Лист1).Cell(3,3) <-- (Лист2).Cell(2,3) если sheets(Лист1).Cell(2,4)=sheets(Лист2).Cell(1,4) To (Лист1).Cell(3,4) <-- (Лист2).Cell(2,4) если sheets(Лист1).Cell(2,5)=sheets(Лист2).Cell(1,5) To (Лист1).Cell(3,5) <-- (Лист2).Cell(2,5) если sheets(Лист1).Cell(2,6)=sheets(Лист2).Cell(1,6) To (Лист1).Cell(3,6) <-- (Лист2).Cell(2,6)
[/vba]
Чую что нефига не кратенько вышло. Есть надежда на метод последовательного приближения(к истине, к правде и так далее...)...))))
Логика такова:
Активный лист - Лист 1. В Лист 1, в строке=2, в ячейках содержатся имена. В Лист 2, в строке=1, в ячейках содержатся имена. Имена в Лист 1 и Лист 2 - сравниваются циклами по столбцам, используем в каждом цикле Cells(x,y). Если Ячейка.Лист1 совпали Ячейка.Лист2( то тогда совпали и номера столбцов сравниваемых ячеек). Тогда на Лист1 запускается цикл копирования ячеек строки из Лист 2. Стартовый адрес копируемых ячеек(Источник) Лист2.Cells(2, номер столбца совпавший) Адрес назначения Лист1.Cells(3, номер столбца совпавший). Операция повторяется пока все ячейки Лист2 не будут скопированы в Лист1 по соответствующим ячейкам. [vba]
Код
То есть кратко-данные из Лист2 скопировать в Лист1 по условию Лист1.Ячейка=Лист2.Ячейка: Старт: если sheets(Лист1).Cell(2,2)=sheets(Лист2).Cell(1,2) To (Лист1).Cell(3,2) <-- (Лист2).Cell(2,2) если sheets(Лист1).Cell(2,3)=sheets(Лист2).Cell(1,3) To (Лист1).Cell(3,3) <-- (Лист2).Cell(2,3) если sheets(Лист1).Cell(2,4)=sheets(Лист2).Cell(1,4) To (Лист1).Cell(3,4) <-- (Лист2).Cell(2,4) если sheets(Лист1).Cell(2,5)=sheets(Лист2).Cell(1,5) To (Лист1).Cell(3,5) <-- (Лист2).Cell(2,5) если sheets(Лист1).Cell(2,6)=sheets(Лист2).Cell(1,6) To (Лист1).Cell(3,6) <-- (Лист2).Cell(2,6)
[/vba]
Чую что нефига не кратенько вышло. Есть надежда на метод последовательного приближения(к истине, к правде и так далее...)...))))alexban65
Сообщение отредактировал alexban65 - Вторник, 09.04.2019, 13:35
Голова - предмет темный, и исследованию не подлежит (С)
Простите великодушно - черт попутал. Удалил я верхние 3 строки в листе 1 - а мысленно еще там где они есть...((( Вот так правильно - в Лист1, в строке 2.
Попробовал цикл DO while, тоже как то не очень: [vba]
Код
a = 1 b = 1 Do While a <= iEndCol a = a + 1 Do While b <= lEndCol b = b + 1 If Sheets("ПК").Cells(1, b) = Sheets("Sheet1").Cells(2, a) Then 'MsgBox Sheets("ПК").Cells(1, b) & " " & b & " === " & a & " " & Sheets("Sheet1").Cells(2, a), , "Вход" MsgBox Sheets("ПК").Cells(1, b) & " === " & Sheets("Sheet1").Cells(2, a), , "Вход" Exit Do End If Loop If Sheets("ПК").Cells(1, b) <> Sheets("Sheet1").Cells(2, a) Then MsgBox Sheets("ПК").Cells(1, b) & b & " === " & a & Sheets("Sheet1").Cells(2, a), , "ячейки не равны-неповезло !!!" End If Loop MsgBox " <> END!!! " & Sheets("Sheet1").Cells(iLastRow, iEndCol)
[/vba]
Голова - предмет темный, и исследованию не подлежит (С)
Простите великодушно - черт попутал. Удалил я верхние 3 строки в листе 1 - а мысленно еще там где они есть...((( Вот так правильно - в Лист1, в строке 2.
Попробовал цикл DO while, тоже как то не очень: [vba]
Код
a = 1 b = 1 Do While a <= iEndCol a = a + 1 Do While b <= lEndCol b = b + 1 If Sheets("ПК").Cells(1, b) = Sheets("Sheet1").Cells(2, a) Then 'MsgBox Sheets("ПК").Cells(1, b) & " " & b & " === " & a & " " & Sheets("Sheet1").Cells(2, a), , "Вход" MsgBox Sheets("ПК").Cells(1, b) & " === " & Sheets("Sheet1").Cells(2, a), , "Вход" Exit Do End If Loop If Sheets("ПК").Cells(1, b) <> Sheets("Sheet1").Cells(2, a) Then MsgBox Sheets("ПК").Cells(1, b) & b & " === " & a & Sheets("Sheet1").Cells(2, a), , "ячейки не равны-неповезло !!!" End If Loop MsgBox " <> END!!! " & Sheets("Sheet1").Cells(iLastRow, iEndCol)
то есть мы пытаемся по названиям во 2 строке листа1 подтянуть данные соответствующих столбцов из пк. Однако что будет если дважды копировать - они добавляются или перезаписываем?
то есть мы пытаемся по названиям во 2 строке листа1 подтянуть данные соответствующих столбцов из пк. Однако что будет если дважды копировать - они добавляются или перезаписываем?skais
Хотелось бы обойтись без двойного копирования, это сильно замедляет - поскольку столбцов в Лист1 много, а строк в Лист2 может быть в десятки и больше раз больше. Но если есть двойное копирование - то одинаковые ячейки перезаписывать.
Хотелось бы обойтись без двойного копирования, это сильно замедляет - поскольку столбцов в Лист1 много, а строк в Лист2 может быть в десятки и больше раз больше. Но если есть двойное копирование - то одинаковые ячейки перезаписывать.alexban65
Private Sub CommandButton3_Click() Application.ScreenUpdating = False With Sheets("ПК") arr2 = .UsedRange.Value End With
With Sheets("Sheet1") arr1 = .UsedRange.Value .UsedRange.Offset(2, 0).ClearContents
For i = 1 To UBound(arr1, 2) For j = 1 To UBound(arr2, 2) If arr1(2, i) = arr2(1, j) Then For h = 2 To UBound(arr2, 1) If arr2(h, j) <> "" Then .Cells(h + 1, i) = arr2(h, j) Next Exit For End If Next Next End With Application.ScreenUpdating = True End Sub
[/vba]
Решение. [vba]
Код
Private Sub CommandButton3_Click() Application.ScreenUpdating = False With Sheets("ПК") arr2 = .UsedRange.Value End With
With Sheets("Sheet1") arr1 = .UsedRange.Value .UsedRange.Offset(2, 0).ClearContents
For i = 1 To UBound(arr1, 2) For j = 1 To UBound(arr2, 2) If arr1(2, i) = arr2(1, j) Then For h = 2 To UBound(arr2, 1) If arr2(h, j) <> "" Then .Cells(h + 1, i) = arr2(h, j) Next Exit For End If Next Next End With Application.ScreenUpdating = True End Sub
Погонял решение в разных вариациях. Поскольку в массивах пока не очень, хотя и стараюсь, то экспериментировал в пределах своих знаний...))) Решение и код - годное, но, на мой взгляд, жестковатое. Даже не представляю себе, какой напильник надо для модификации кода...))) 1. Заполнение ячеек на Лист1(видимо, на Лист2 чтение идет тоже так же...) идет сверху вниз - задумывалось заполнять ячейки слева направо. Так как при заполнения всех ячеек в строке - хотелось бы проанализировать собранную строку, что то вставить по допусловию самостоятельно, например типа [vba]
Код
IF Sheet("ПК").Unique_Id.Value = Sheet("Ответственные").Container_Unique_Id.Value Then
[/vba] повторять заполнение пока верно условие. Как в такой реализации, при формировании сверху вниз, добавить то что задумал - пока не представляю. 2. При игре параметрами массив по листу целиком не перемещается - он просто усекается. Хотелось бы его подвигать вправо, влево, вверх, в низ. Хотя, вполне возможно, погонял параметры не до конца. 3. Думал что будет больше переменных - так проще адаптировать код для других задач...)))
Претензий, жалоб нет - конечный результат великолепный, именно такой, какой и задумывался, плюс в карму однозначно! Но, если есть возможность учесть п.1 и п.2 и п.3, или пояснить их....)))
Погонял решение в разных вариациях. Поскольку в массивах пока не очень, хотя и стараюсь, то экспериментировал в пределах своих знаний...))) Решение и код - годное, но, на мой взгляд, жестковатое. Даже не представляю себе, какой напильник надо для модификации кода...))) 1. Заполнение ячеек на Лист1(видимо, на Лист2 чтение идет тоже так же...) идет сверху вниз - задумывалось заполнять ячейки слева направо. Так как при заполнения всех ячеек в строке - хотелось бы проанализировать собранную строку, что то вставить по допусловию самостоятельно, например типа [vba]
Код
IF Sheet("ПК").Unique_Id.Value = Sheet("Ответственные").Container_Unique_Id.Value Then
[/vba] повторять заполнение пока верно условие. Как в такой реализации, при формировании сверху вниз, добавить то что задумал - пока не представляю. 2. При игре параметрами массив по листу целиком не перемещается - он просто усекается. Хотелось бы его подвигать вправо, влево, вверх, в низ. Хотя, вполне возможно, погонял параметры не до конца. 3. Думал что будет больше переменных - так проще адаптировать код для других задач...)))
Претензий, жалоб нет - конечный результат великолепный, именно такой, какой и задумывался, плюс в карму однозначно! Но, если есть возможность учесть п.1 и п.2 и п.3, или пояснить их....)))alexban65
Сообщение отредактировал alexban65 - Среда, 10.04.2019, 10:11
alexban65 У Вас был вопрос - он был решен. Что касается других моментов создавайте отдельные темы или одну в разделе работа. У Вас по сути уже не вопрос, а тз. Да и эта тема тоже имеет широкое понятие. В итоге Вы хотите получить какого-то универсального монстра. Если в нем смысл - или лучше определиться с тз и выполнить и забыть? Сделать можно все, но это нарушение правил форума - одна тема - один вопрос.
alexban65 У Вас был вопрос - он был решен. Что касается других моментов создавайте отдельные темы или одну в разделе работа. У Вас по сути уже не вопрос, а тз. Да и эта тема тоже имеет широкое понятие. В итоге Вы хотите получить какого-то универсального монстра. Если в нем смысл - или лучше определиться с тз и выполнить и забыть? Сделать можно все, но это нарушение правил форума - одна тема - один вопрос.skais
Ладно, коли так - тогда заморачиваться не стоит. Сделал пока так - создал Лист3, копирую туда данные из Лист2, задаю условия для обработки, получаю аналог Лист2 но с нужными мне данными и параметрами, после того как Лист3 полностью сформируется- забираю данные в Лист1. Потом, со временем, разберемся...)))
Благодарю за участие!
Ладно, коли так - тогда заморачиваться не стоит. Сделал пока так - создал Лист3, копирую туда данные из Лист2, задаю условия для обработки, получаю аналог Лист2 но с нужными мне данными и параметрами, после того как Лист3 полностью сформируется- забираю данные в Лист1. Потом, со временем, разберемся...)))
1. При работе на листе по строкам вообще выводить не нужно, просто берем сразу весь нужный столбец и вставляем в найденное место. Третий цикл лишний, тем более, что он очень много времени занимает. При работе внутри кода (без кучи обращений к листу) да, бегаем еще и по строкам (там это быстро работает) 2. Это Вы про что? Что куда по каким параметрам Вы собираетесь двигать? 3. Какие конкретно переменные Вас интересуют?
Мой вариант макроса с комментариями [vba]
Код
Sub tt() ar2 = Sheets("ПК").UsedRange.Value 'данные с листа ПК - в массив Set slov2 = CreateObject("Scripting.Dictionary") 'объявляем словарь With slov2 'работаем с этим словарем For i = 1 To UBound(ar2, 2) 'цикл по столбцам массива ar2 .Item(ar2(1, i)) = i 'заполняем словарь. Ключ=значение шапки, элемент=номер столбца Next i c_ = Cells(2, Columns.Count).End(1).Column 'номер последнего столбца на активном листе ar1 = Cells(2, 2).Resize(UBound(ar2), c_ - 1).Value 'с ячейки В2 акт. листа вниз столько, сколько строк в ar2, вправо на с_-1 For i = 1 To UBound(ar1, 2) 'цикл по столбцам массива ar1 If .exists(ar1(1, i)) Then 'если такое название есть в словаре n_ = .Item(ar1(1, i)) 'номер столбца на листе ПК For j = 2 To UBound(ar2, 2) 'цикл по строкам ar1(j, i) = ar2(j, n_) 'перенос строк из массива в массив Next j End If Next i End With Cells(2, 2).Resize(UBound(ar2), c_ - 1) = ar1 'данные из массива ar1 выносим на лист End Sub
[/vba] Код немного поправил, файл перевложил
1. При работе на листе по строкам вообще выводить не нужно, просто берем сразу весь нужный столбец и вставляем в найденное место. Третий цикл лишний, тем более, что он очень много времени занимает. При работе внутри кода (без кучи обращений к листу) да, бегаем еще и по строкам (там это быстро работает) 2. Это Вы про что? Что куда по каким параметрам Вы собираетесь двигать? 3. Какие конкретно переменные Вас интересуют?
Мой вариант макроса с комментариями [vba]
Код
Sub tt() ar2 = Sheets("ПК").UsedRange.Value 'данные с листа ПК - в массив Set slov2 = CreateObject("Scripting.Dictionary") 'объявляем словарь With slov2 'работаем с этим словарем For i = 1 To UBound(ar2, 2) 'цикл по столбцам массива ar2 .Item(ar2(1, i)) = i 'заполняем словарь. Ключ=значение шапки, элемент=номер столбца Next i c_ = Cells(2, Columns.Count).End(1).Column 'номер последнего столбца на активном листе ar1 = Cells(2, 2).Resize(UBound(ar2), c_ - 1).Value 'с ячейки В2 акт. листа вниз столько, сколько строк в ar2, вправо на с_-1 For i = 1 To UBound(ar1, 2) 'цикл по столбцам массива ar1 If .exists(ar1(1, i)) Then 'если такое название есть в словаре n_ = .Item(ar1(1, i)) 'номер столбца на листе ПК For j = 2 To UBound(ar2, 2) 'цикл по строкам ar1(j, i) = ar2(j, n_) 'перенос строк из массива в массив Next j End If Next i End With Cells(2, 2).Resize(UBound(ar2), c_ - 1) = ar1 'данные из массива ar1 выносим на лист End Sub
[/vba] Код немного поправил, файл перевложил_Boroda_
Со словарями - код понятный, читабельный. Хотя по словарям не спец - думаю что разберусь...) Чую руку мастера...))) По ощущению - код работает даже быстрее чем чем массивами. Что то с размерностями - кладет количество строк по количеству столбцов, то есть не выбирает весь диапазон из листа "ПК".
Со словарями - код понятный, читабельный. Хотя по словарям не спец - думаю что разберусь...) Чую руку мастера...))) По ощущению - код работает даже быстрее чем чем массивами. Что то с размерностями - кладет количество строк по количеству столбцов, то есть не выбирает весь диапазон из листа "ПК".alexban65
По ощущению - код работает даже быстрее чем чем массивами
Особенно развеселило слово "даже". Проверьте хотя бы на 1000 строк, разница в скорости в 23 раза. А на 10000 строк макрос "массивами" вообще завис_Boroda_
Я правильно понимаю, что алгоритм копирует шапку в массив, и из массива на лист- в итоге перезаписывая шапку? Потому как добавил несколько строк в шапку, внес изменения. Теперь копирует данные с нужной мне позиции, но данные копируется вместе с шапкой...)))
Шапка нужна в словаре, для работы - но в дальнейшем она не нужна. Пробовал отсечь шапку при переносе из массива в массив - получилось частично.(( В некоторые пустые столбцы шапка все же просочилась. Видимо, где то по _n идет все таки перезапись?...(( Как поправить?
Я правильно понимаю, что алгоритм копирует шапку в массив, и из массива на лист- в итоге перезаписывая шапку? Потому как добавил несколько строк в шапку, внес изменения. Теперь копирует данные с нужной мне позиции, но данные копируется вместе с шапкой...)))
Шапка нужна в словаре, для работы - но в дальнейшем она не нужна. Пробовал отсечь шапку при переносе из массива в массив - получилось частично.(( В некоторые пустые столбцы шапка все же просочилась. Видимо, где то по _n идет все таки перезапись?...(( Как поправить?alexban65
Sub tt() ar2 = Sheets("ПК").UsedRange.Value 'данные с листа ПК - в массив Set slov2 = CreateObject("Scripting.Dictionary") 'объявляем словарь With slov2 'работаем с этим словарем For i = 1 To UBound(ar2, 2) 'цикл по столбцам массива ar2 .Item(ar2(1, i)) = i 'заполняем словарь. Ключ=значение шапки, элемент=номер столбца Next i c_ = Cells(5, Columns.Count).End(1).Column 'номер последнего столбца на активном листе ar1 = Cells(5, 2).Resize(UBound(ar2) + 1, c_ - 1).Value 'с ячейки В2 акт. листа вниз столько, сколько строк в ar2, вправо на с_-1 For i = 1 To UBound(ar1, 2) 'цикл по столбцам массива ar1 If .exists(ar1(1, i)) Then 'если такое название есть в словаре n_ = .Item(ar1(1, i)) 'номер столбца на листе ПК For j = 2 To UBound(ar2) 'цикл по строкам ' ' Шапка при переносе в массив не нужна(верно j-1) ' НЕВЕРНО! 'ar1(j, i) = ar2(j, n_) ar1(j + 1, i) = ar2(j, n_) 'перенос строк из массива в массив Next j End If Next i End With Cells(5, 2).Resize(UBound(ar2) + 1, c_ - 1) = ar1 'данные из массива ar1 выносим на лист End Sub
[/vba]
Чет Вы мудрите всё Держите [vba]
Код
Sub tt() ar2 = Sheets("ПК").UsedRange.Value 'данные с листа ПК - в массив Set slov2 = CreateObject("Scripting.Dictionary") 'объявляем словарь With slov2 'работаем с этим словарем For i = 1 To UBound(ar2, 2) 'цикл по столбцам массива ar2 .Item(ar2(1, i)) = i 'заполняем словарь. Ключ=значение шапки, элемент=номер столбца Next i c_ = Cells(5, Columns.Count).End(1).Column 'номер последнего столбца на активном листе ar1 = Cells(5, 2).Resize(UBound(ar2) + 1, c_ - 1).Value 'с ячейки В2 акт. листа вниз столько, сколько строк в ar2, вправо на с_-1 For i = 1 To UBound(ar1, 2) 'цикл по столбцам массива ar1 If .exists(ar1(1, i)) Then 'если такое название есть в словаре n_ = .Item(ar1(1, i)) 'номер столбца на листе ПК For j = 2 To UBound(ar2) 'цикл по строкам ' ' Шапка при переносе в массив не нужна(верно j-1) ' НЕВЕРНО! 'ar1(j, i) = ar2(j, n_) ar1(j + 1, i) = ar2(j, n_) 'перенос строк из массива в массив Next j End If Next i End With Cells(5, 2).Resize(UBound(ar2) + 1, c_ - 1) = ar1 'данные из массива ar1 выносим на лист End Sub