Решение задачи по копированию данных с одного листа на другой без использования и с использованием массивов. Вызов из кода VBA Excel других процедур.
Условие задачи по копированию данных
На одном листе расположен список повторяющихся городов с информацией о предприятиях общепита:
Исходная таблица задания №1
Необходимо данные по каждому городу перенести в одну строку на другом листе (таблица обрезана справа):
Часть результирующего списка задания №1
Решение копированием с листа на лист
Это решение значительно проще, чем с использованием массивов, но более медленное. При больших объемах информации обработка может длиться достаточно долго. Решение достигается путем присваивания значений ячеек из таблицы первого листа ячейкам второго листа.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
Sub Resheniye1() Dim n1 As Long, n2 As Long, n3 As Long, n4 As Long, _ i1 As Long, gorod As Variant n1 = Sheets(«Лист1»).Cells(1, 1).CurrentRegion.Rows.Count For i1 = 1 To n1 With Sheets(«Лист1») If gorod <> .Cells(i1, 1) Then gorod = .Cells(i1, 1) n2 = 1 n3 = n3 + 1 n4 = 1 Else n2 = 2 End If Do While .Cells(i1, n2) <> «» Sheets(«Лист2»).Cells(n3, n4) = .Cells(i1, n2) n4 = n4 + 1 n2 = n2 + 1 Loop End With Next End Sub |
Переменные:
- n1 – количество строк в исходной таблице;
- n2 – номер столбца текущей ячейки исходной таблицы, к которой обращается цикл;
- n3 – номер строки текущей ячейки на втором листе;
- n4 – номер столбца текущей ячейки на втором листе;
- i1 – счетчик цикла For… Next;
- gorod – переменная с наименованием города, предназначенная для контроля за сменой текущего города, который обрабатывается циклом.
Решение с использованием массивов
Циклы в массивах работают очень быстро, но решение с ними может быть сложнее, чем при простом присваивании значений одних ячеек другим. В этом примере для упрощения кода две процедуры записаны отдельно и в нужные моменты вызываются для исполнения.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 |
‘Объявление глобальных переменных ‘в разделе Declarations Dim massiv1 As Variant, n2 As Long, _ n3 As Long, i1 As Long, txt1 As Variant ‘Исполняемая процедура для решения ‘задания вторым способом Sub Resheniye2() Dim n1 As Long, gorod As Variant With Sheets(«Лист1»).Cells(1, 1) massiv1 = .CurrentRegion n1 = .CurrentRegion.Rows.Count n2 = .CurrentRegion.Columns.Count End With n3 = 0 txt1 = «» For i1 = 1 To n1 If gorod <> massiv1(i1, 1) Then If txt1 <> «» Then Call Vstavka End If gorod = massiv1(i1, 1) txt1 = massiv1(i1, 1) Call Kopirovanie Else Call Kopirovanie End If If i1 = n1 Then Call Vstavka End If Next End Sub ‘Копирование данных из массива в ‘строковую переменную через разделитель Sub Kopirovanie() Dim i2 As Long For i2 = 2 To n2 If massiv1(i1, i2) <> Empty Then txt1 = txt1 & «|» & massiv1(i1, i2) End If Next End Sub ‘Обработка данных из строковой ‘переменной в дополнительных массивах и ‘вставка очередной строки на второй лист Sub Vstavka() Dim n4 As Long, massiv2 As Variant, _ massiv3 As Variant, i3 As Long n3 = n3 + 1 massiv2 = Split(txt1, «|») n4 = UBound(massiv2) ReDim massiv3(0 To 0, 0 To n4) For i3 = 0 To n4 massiv3(0, i3) = massiv2(i3) Next Sheets(«Лист2»).Range(Cells(n3, 1), _ Cells(n3, n4 + 1)).Value = massiv3 End Sub |
Подпрограммы Kopirovanie
и Vstavka
используются в цикле For... Next
процедуры Resheniye2
по два раза, поэтому их коды вынесены за пределы процедуры Resheniye2
и вызываются по мере необходимости.
Переменные:
- massiv1 – его элементам присваиваются значения ячеек исходной таблицы;
- massiv2 – одномерный массив, заполняемый данными из переменной txt1;
- massiv3 – двумерный массив, заполняемый данными из одномерного массива massiv2 и используемый для вставки очередной строки на второй лист;
- txt1 – сюда копируются через разделитель значения элементов массива massiv1, предназначенные для заполнения очередной строки на втором листе;
- n1 – количество строк в исходной таблице;
- n2 – количество столбцов в исходной таблице;
- n3 – номер текущей строки на втором листе;
- n4 – количество столбцов текущей строки на втором листе (соответствует количеству элементов массива massiv2);
- i1, i2, i3 – счетчики цикла For… Next;
- gorod – переменная с наименованием города, предназначенная для контроля за сменой текущего города, который обрабатывается циклом.
Переменные, использующиеся более чем в одной процедуре, объявлены как глобальные в разделе Declarations
программного модуля.
sbirliko Пользователь Сообщений: 98 sbi |
Уважаемые форумчане! Заранее спасибо! Прикрепленные файлы
|
KuklP Пользователь Сообщений: 14868 E-mail и реквизиты в профиле. |
А самому что-нить сделать, хоть макрорекордером? А поиск потерзать? Уж столько напереносили по условию, неинтересно. А стол заказов в разделе Работа. Я сам — дурнее всякого примера! … |
МВТ Пользователь Сообщений: 1198 |
#3 07.04.2015 12:56:06 Несмотря на то, что я полностью согласен с KuklP, вот код:
|
||
sbirliko Пользователь Сообщений: 98 sbi |
#4 07.04.2015 13:00:03 KuklP
добрый день. к сожалению своих извилин не хватает.. даже на редактирование макросов с других примеров, которые были найдены с помощью поиска..
а сделать это через макроредактор сложно, т.к. я не знаю как создать привязку к условию(то что указано в примере) ну уж простите, если это тема уже приелась… |
||
МВТ Пользователь Сообщений: 1198 |
sbirliko, не расстраивайтесь и оформите код макроса как положено (кнопка <…>). Макрос я написал по Вашим таблицам, попробуйте |
sbirliko Пользователь Сообщений: 98 sbi |
МВТ
, Спасибо большое! Но, кажется ваш код написан вовсе не макроредактором….))) |
МВТ Пользователь Сообщений: 1198 |
sbirliko, я и не говорил, что рекордером . Да строки можно удалять, вставлять или менять: после окончания работы макроса таблицы никак друг с другом не связаны. Таблица-результат не имеет ссылок на Таблицу-источник, макрос просто снимает защиту, копирует отобранную информацию на другой лист и снова ставит защиту. |
KuklP Пользователь Сообщений: 14868 E-mail и реквизиты в профиле. |
#8 07.04.2015 13:52:05 Вариант:
Я сам — дурнее всякого примера! … |
||
KuklP Пользователь Сообщений: 14868 E-mail и реквизиты в профиле. |
#9 07.04.2015 14:08:12 Забыл. Так еще и удалит строки с исходной. И это — макрорекордером. С доработкой.
Прикрепленные файлы
Я сам — дурнее всякого примера! … |
||
МВТ Пользователь Сообщений: 1198 |
KuklP, идея с автофильтром хороша (не сообразил, честно), но там надо не все колонки переносить и нумерацию обновлять |
sbirliko Пользователь Сообщений: 98 sbi |
c нумерацией нет проблем, можно не обновлять… но возник другой вопросик, вернее я упустил(результат нехватки времени , простите, приходится писать только когда есть свободная минутка) возможно ли доработка макроса для добавления перенесенных данных на последнюю свободную строку в листе History_? ps-скачал книгу Мэтью Харрис по VBA, буду изучать дома, по выходным… (хотя нет инета и компа дома, хоть буду теорию знать) |
МВТ Пользователь Сообщений: 1198 |
sbirliko, возможно, но если Вы не удалите заранее уже перенесенные строки из таблицы-источника, они продублируются в таблице-результате. Как вариант, можно удалять уже перенесенную строку из источника. В принципе, можно даже видоизменить, чтобы при внесении Выполнено в колонку Статус, соответствующая строка переносилась в результирующую таблицу и удалялась из исходной. Подумайте, как Вы планируете организовать свои данные и исходя уже из этого можно будет пробовать что-то сделать |
KuklP Пользователь Сообщений: 14868 E-mail и реквизиты в профиле. |
МВТ, Те колонки, что не надо переносить(я не обратил внимания) можно просто скрыть на время переноса. Я сам — дурнее всякого примера! … |
KuklP Пользователь Сообщений: 14868 E-mail и реквизиты в профиле. |
#14 07.04.2015 15:04:04 Так, вроде все учел:
Прикрепленные файлы
Изменено: KuklP — 07.04.2015 15:09:45 Я сам — дурнее всякого примера! … |
||
sbirliko Пользователь Сообщений: 98 sbi |
KuklP
и МВТ большое спасибо за оказанную помощь! |
Strizh Пользователь Сообщений: 76 |
Отличный макрос, огромнейшее спасибо! |
Strizh Пользователь Сообщений: 76 |
#17 26.07.2019 16:38:04 KuklP, добрый день! |
Есть книга, в которой 10 листов. Нужно скопировать содержимое 8-го листа в 3-й лист.
Я пытался сделать это следующим способом:
Set CurrentWorkbook = ThisWorkbook
Set sheetTemp = CurrentWorkbook.Worksheets(8)
With Application: .ScreenUpdating = False: .DisplayAlerts = False: End With
With CurrentWorkbook
sheetTemp.Copy CurrentWorkbook.Worksheets(3)
End With
With Application: .ScreenUpdating = True: .DisplayAlerts = True: End With
Все работает, но вместо записи в 3-й лист оно создает перед третьим листом новый лист. Как сделать так, чтобы при копировании не создавался новый лист и записывалось в существующий лист?
задан 21 сен 2018 в 10:35
2
Полное копирование столбцов (ширина, форматирование, значения, примечания…):
Sub CopyRange()
Worksheets("Лист1").Columns("C:E").Copy
Worksheets("Лист2").Columns("C:E").PasteSpecial
End Sub
или
Sub CopyRange()
Worksheets("Лист1").Columns("C:E").Copy Worksheets("Лист2").Columns("C:E")
End Sub
Для копирования только нужного:
Worksheets("Лист1").Range("C3:E50").Copy
With Worksheets("Лист2").Range("C3")
.PasteSpecial xlPasteColumnWidths ' ширина столбца'
.PasteSpecial xlPasteValues' значения'
.PasteSpecial xlPasteFormats' форматы'
.PasteSpecial xlPasteFormulasAndNumberFormats ' формулы'
' .....'
End With
После копирования очистить буфер:
Application.CutCopyMode = False
ответ дан 21 сен 2018 в 11:38
Задача состоит в том, чтобы скопировать определенный диапазон текущего листа, открыть другую книгу, и вставить эти скопированные данные в определенную ячейку, сохранить этот файл и закрыть. Ниже приведен код VBA.
Sub Название_Макроса() 'Выделить диапазон который необходимо скопировать Range("A1:F52").Select 'Скопировать то, что выделено Selection.Copy ChDir "путь к папке где лежит файл в который необходимо скопировать" Workbooks.Open Filename:= "Название файла, который находится в папке, путь к которой указан выше" 'Выделить начальную ячейку в которую необходимо вставить скопированные данные Range("A6").Select 'Вставить данные ActiveSheet.Paste 'сохранить текущую книгу ActiveWorkbook.Save 'Закрыть книгу ActiveWorkbook.Close End Sub
Вариант 2: В открывшейся книге запускаем макрос, чтобы он открыл нужную нам книгу, скопировал от туда нужные нам данные и вставил в нашу открытую книгу, закрыв файл из которого эти данные были скопированы
Sub Название_Макроса2() 'Открываем файл с которого нужно скопировать данные Workbooks.Open Filename:="C:Данные.xlsx" 'Скопировать нужный диапазон в открывшейся книге на листе 1 Workbooks("Данные.xlsx").Worksheets("Лист1").Range("A16:E16").Copy 'Активируем нужную нам книгу Workbooks("Книга1.xlsm").Activate 'Выделяем и вставляем скопированные данные в ячейку А1 ActiveWorkbook.Worksheets("Лист1").Range("A1").Select ActiveSheet.Paste 'Закрываем книгу откуда мы скопировали данные Workbooks("Данные.xlsx").Close End Sub
Еще пример — Скопировать диапазоны данных из активной открытой книги Excel нескольких листов (в нашем примере 3-х листов) в другую книгу, которая хранится в определенном месте. Данные будут вставлены как значения, плюс будут перенесены форматы ячеек.
Sub Копируем_листы_в_другую_книгу() Dim bookconst As Workbook Dim abook As Workbook Set abook = ActiveWorkbook 'присваиваем перменную активной книге Set bookconst = Workbooks.Open("C:UsersUserDesktop1.xlsx") 'присваиваем перменную книге куда необходимо копировать данные 'переходим в активную книгу откуда необходимо скопировать данные abook.Worksheets("Лист1").Activate Range("A1:I23").Copy 'копируем определенный диапазон листа, укажите свой диапазон bookconst.Worksheets("Лист1").Activate 'активируем лист куда необходимо вставить данные Range("A1:I23").Select 'встаем на ячейку А1 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False 'вставляем только форматы ячеек Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False 'второй лист abook.Worksheets("Лист2").Activate Range("A1:I23").Copy bookconst.Worksheets("Лист2").Activate Range("A1:I23").Select 'выделяем диапазон Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False 'вставляем только форматы ячеек Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False 'третий лист abook.Worksheets("Лист3").Activate Range("A1:I23").Copy bookconst.Worksheets("Лист3").Activate Range("A1:I23").Select 'выделяем диапазон Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False 'вставляем только форматы ячеек Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False 'сохранить текущую книгу bookconst.Save 'Закрыть книгу bookconst.Close abook.Activate End Sub
Если статья была вам полезна, то буду благодарен, если вы поделитесь ей со своими друзьями с помощью кнопок расположенных ниже.
Спасибо за внимание.
На одном листе таблица из этой таблицы нужно перенести данные для расчета в квитанции, другой лист. Например в ячейку на листе 2 фиО если на первой странице Новиков Илья Васильевич она должна отобразиться в ячейке A4 «=’1′!C5» потом сумма переработки, она относится к «=’1′!AS5», потом вычеты они относятся к «=’1′!AW5» и так далее, как вы выше писали, так и надо прописать. Все эти данные относятся к строке пять, следующий человек к строке 6 и все те же данные. Вот как макрос прописать я незнаю, пробывал у меня не получилось.
Добавлено через 11 минут
Алгоритм
На листе 2 нажимаю на ячейку A4, в этой ячейке ставлю формулу «=’1′!AW5», далее под графой «Сумма переработки» на листе 2 ставлю «=’1′!AS5», далее аналогично под графой «Вычеты»
ставлю «=’1′!AW5», далее под графой «Командировочны» ставлю «=’1′!AT5», далее на листе 2 под графой «доплата за а/м
ставлю «=’1′!BC5», далее так же на листе 2 под графой Оклад ставлю «=’1′!AQ5», далее на листе 2 под графой «Оклад» ставлю «=’1′!AQ5», далее под графой авнс на 2 листе ставлю
«=’1′!BF5», далее под графой доп.выплаты ставлю «=’1′!BC5».