Решение задачи по копированию данных с одного листа на другой без использования и с использованием массивов. Вызов из кода 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 программного модуля.
На одном листе таблица из этой таблицы нужно перенести данные для расчета в квитанции, другой лист. Например в ячейку на листе 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».
|
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
Если статья была вам полезна, то буду благодарен, если вы поделитесь ей со своими друзьями с помощью кнопок расположенных ниже.
Спасибо за внимание.
У меня есть книга Excel с 4 листами.
- Мастер лист
- test_1
- test_2
- test_3
Я хочу переместить данные из мастер-листа на все остальные листы, что я и сделал, создав макрос. Ежедневно данные мастер-листа будут увеличиваться, так как я могу учесть это изменение в макросе.
Я вставил свой существующий код ниже:
Sub sbCopyRangeToAnotherSheet()
Sheets("Master").Range("B10:M1628").Copy
Sheets("test_1").Activate
Range("B9").Select
ActiveSheet.Paste
Application.CutCopyMode = Flase
End Sub
Sub sbCopyRangeToCRP2()
Sheets("Master").Range("B10:M1628").Copy
Sheets("test_2").Activate
Range("B9").Select
ActiveSheet.Paste
Application.CutCopyMode = Flase
End Sub
Sub sbCopyRangeToCRP3()
Sheets("Master").Range("B10:M1628").Copy
Sheets("test_3").Activate
Range("B9").Select
ActiveSheet.Paste
Application.CutCopyMode = Flase
End Sub
В приведенном выше коде я упомянул жестко закодированное значение диапазона мастер-листа, которое начинается с B10 и заканчивается на M1628.
В дальнейшем количество строк увеличивается **(диапазон B10 останется)** и я не хочу жестко кодировать диапазон. Как я могу сделать это?
2017-03-14 08:10
4
ответа
Решение
Я предлагаю объединить эти 3 подпрограммы в одну, которую вы можете использовать повторно, указав рабочий лист в качестве параметра:
Sub sbCopyRangeToAnotherSheet(ToSheet As Worksheet)
Dim LastUsedRow As Long
With Sheets("Master")
LastUsedRow = .UsedRange.Row + .UsedRange.Rows.Count - 1
.Range("B10:M" & LastUsedRow).Copy ToSheet.Range("B9")
End With
Application.CutCopyMode = False
End Sub
Затем вы можете запустить этот саб для любого имени листа, как
Sub test_1()
sbCopyRangeToAnotherSheet Sheets("test_1")
'and for the second sheet
sbCopyRangeToAnotherSheet Sheets("test_2")
End Sub
2017-03-14 08:33
Я бы предложил либо использовать UsedRange свойство объекта Worksheet,
или определить именованные диапазоны на листе, которые автоматически расширяются по мере роста данных на листе, например: =OFFSET($A$1,0,0,COUNTA($A:$A),1)
2017-03-14 08:15
Вы можете использовать этот макрос
Sub CopyAll()
Dim src As Range, dest
With Worksheets("Master") ' set the source range
Set src = .Range("B10:M" & .Cells(.Rows.Count, "B").End(xlUp).Row)
End With
For Each dest In Array("test_1", "test_2", "test_3") ' loop on destination sheets
src.Copy Worksheets(dest).Range("B9")
Next
End Sub
2017-03-14 08:41
Я думаю, что самый простой способ скопировать данные — это использовать массив, который заполнен динамически.
- Создать точный массив
- Заполните данные из мастер-листа
- Вставьте данные.
И в этом случае вам не нужно беспокоиться о новой строке, потому что вы используете динамический массив. Смотрите пример ниже.
Sub sbCopyRangeToAnotherSheet()
Sheets("Master").Select
Dim RowNum as integer
For i = 0 To 250000 'Count all rows
If IsEmpty(Cells(i + 10, 2)) = False Then
RowNum = RowNum + 1 'Count all rows which have data in it's second column
Else
Exit For
End If
Next
ReDim myData(RowNum - 1, 12) As String 'create array
For i = 0 To RowNum - 1 'fill array, with data
For j = 0 to 12
myData(i, j) = Cells(i + 10, j+2) '+10 because you said B**10**
'+2 because you said **B**10
Next
Next
Sheets("test_1").Activate
For i = 0 To RowNum - 1 'fill array, with data
For j = 0 to 12
Cells(i + 10, j+2) = myData(i, j) 'Fill cells with data
Next
Next
End Sub
2017-03-14 08:38
|
Копирование, с листа на лист (по нескольким условиям) |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |
