Как перенести данные из одной таблицы excel в другую по совпадению

Перенос данных по условию в excel используя макрос

Не редко возникает ситуация, когда необходимо перенести данные из одной таблицы в соответствующие ячейки другой. Как говорится, ничего сложного, когда таких данных мало. В противном случае — это проблематично. А если это нужно делать регулярно, несколько раз в неделю, то сильно напрягает и отнимает уйму времени.

Так и в моем случае, мне понадобилось еженедельно отслеживать позиции своего сайта planero.ru по определенным ключевым словам. И если съем позиций сайта в выдаче Яндекса я осуществляю с помощью небезызвестного Key Collector в автоматическом режиме, результатом работы которого получается экселевский файл следующего вида:

Результат key collerctor’а

В общем, результат работы key collector’а представляет из себя массив данных, который не дает конкретного представления о ситуации в целом. Картину целиком можно увидеть в другой таблице, уже созданной мной, где отражена сама статья с ее продвигаемыми ключевыми словами и позиции, на которых находится мой сайт на дату «02.06.2020». На итог необходимо, при нажатии на кнопку «Заполнить позиции страниц в выдаче», автоматически перенести данные из таблицы key collector’а в мою таблицу, напротив соответствующих ключей, при этом нужно добавить новый столбец с датой съема позиций, а также выделить цветом позиции, которые просели (красным), либо наоборот поднялись (зеленым).

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

наглядное представление позиций ключевых слов

Ну что ж, начнем воплощать в жизнь идею по автоматизации рутинной работы. И начнем с составления формы, которая будет появляться при нажатии на кнопку «Заполнить позиции страниц в выдаче» для выбора экселевского файла кей коллектора и даты съема позиций.

выбор файла экспорта кей коллектора и даты съема

После напишем процедуру вызова UserForm1 на листе «Статьи» при нажатии на соответствующую кнопку. Процедура должна автоматически предоставлять данные по всем открытым книгам Эксель, записывать текущую дату и выравнивать форму по центру экрана. Код процедуры выглядит следующим образом:

Private Sub Worksheet_SelectionChange( ByVal Target As Range)
‘ показать UserForm1 прин нажатии на кнопку «Заполнить позиции страниц в выдаче»
If ActiveCell.Column = 9 And Cells(ActiveCell.Row, ActiveCell.Column).Value = «Заполнить позиции страниц в выдаче» And ActiveCell.Row = 2 Then
‘ ищем все открытые книги экселя
Dim wb As Workbook
For Each wb In Workbooks
With UserForm1.ComboBox1
.AddItem wb.Name ‘ добавляем наименование книги экселя в ComboBox1
End With
Next
‘ выбираем последнюю найденную книгу в ComboBox1
UserForm1.ComboBox1.ListIndex = UserForm1.ComboBox1.ListCount — 1
‘ размещаем UserForm1 по центру экрана как по вертикали так и по горизонтали
UserForm1.Left = maxWidth / 2
UserForm1.Left = maxHeight / 2
‘ автоматически добавляем текущую дату в TextBox1 (т.к. раз нажали сегодня эту кнопку, соответственно и съем позиций был также сегодня. Поэтому зачем лишний раз пользователю лишний раз тратить свое драгоценное время даже на ввод текущей даты?)
UserForm1.TextBox1.Value = Format(Date, «dd.mm.yyyy»)
‘ отображаем UserForm1
UserForm1.Show
‘ перемещаем курсор на A1 с кнопки
Workbooks(«GTD planero.ru.xlsm»).Worksheets(«Статьи»).Range(«A1»).Select
End If
End Sub

Теперь при нажатии на кнопку «Заполнить …» появится форма:

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

Теперь напишем макрос для кнопки «Ок» UserForm1 проверяющий правильность выбора файла excel, т.е. наличия в нем необходимых ключевых фраз и в случае некорректного выбора, информирование пользователя с последующим выбором другого файла.

‘ процедура кнопки «Ok» UserForm1
Private Sub CommandButton1_Click()
‘ скрываем Label3 (информацию об ошибке)
UserForm1.Label3.Visible = False

‘ получаем название выбранного файла эксель
namefile = UserForm1.ComboBox1.Value
‘ ссылка на первый лист выбранной книги
Set poz = Workbooks(namefile).Worksheets(1)
q = 0
‘ нашлась (1) или не нашлась (0) ячейка с наименованием «Фраза»
da = 0
‘ проходим по столбцам первой строки до тех пор пока в них есть данные
Do While poz.Range(«A1»).Offset(0, q) > 0
‘ если нашли столбец с наименованием «Фраза» присваиваем переменной da = 1 и выходим из цикла
If poz.Range(«A1»).Offset(0, q) = «Фраза» Then
da = 1
Exit Do
End If
q = q + 1
Loop

If da = 0 Then
‘ выводим предупреждение о некорректном выборе файла в случае не нахождения в нем ячейки с наименованием «Фраза»
With UserForm1.Label3
.Caption = «В выбранном файле нет данных по фразам и позициям. Выберите другой файл»
.Visible = True
End With
Else
‘ в случае если файл выбран верно — запускаем в работу функцию заполнения позиций fpoz с передачей ей выбранной даты и наименования файла в виде аргументов
a = Module1.fpoz(Date, namefile)
‘ скрываем форму UserForm1
Unload UserForm1
End If
End Sub

И наконец, реализуем самую главную функцию fpoz , которая будет осуществлять сравнение данных двух таблиц, заполнение необходимых строк и выделение цветом соответствующих ячеек. Вкратце сам принцип работы функции выглядит следующим образом:

1. Ищем в шапке таблицы выбранную дату.
2. Добавляем новый столбец c его соответствующим форматированием (в случае если даты выбранной в UserForm1 нет в шапке таблицы).
3. Записываем продвигаемые фразы из нашей таблицы в массив.
4. Находим в файле key collector’а столбец с наименованием «Фраза» и столбце с наименованием «Позиция [Ya]».
5. Записываем ключевые слова из файла key collector’а и столбцов «Фраза», «Позиция[Ya]» в соответствующие массивы.
6. Сравниваем массивы между собой и при совпадении – записываем значение позиции в соответствующую ячейку нашей таблицы, при этом, в случае если предыдущее значение было больше текущего (позиция поднялась) – выделяем его зеленым. И, наоборот, при ухудшении позиции (просела) – красным.

Полностью реализованная функция приведена ниже:

‘ функция заполнения позиций с аргументами mydate — дата введенная в UserForm1, namefile — имя книги, выбранное в UserForm1
Function fpoz(mydate, namefile)
‘ ссылка на лист книги в которую необходимо занести данные
Set ps = Workbooks(«GTD planero.ru.xlsm»).Worksheets(«Статьи»)
‘ ссылка на первый лист книги из которой необходимо брать данные (файл key kollector’а
Set poz = Workbooks(namefile).Worksheets(1)

‘ проходим по странице «Статьи» книги «GTD planero.ru.xlsm» и ищем совпадения в дате или пустую ячейку в строке 4
i = 0 ‘ сколько отступить от ячейки J4
da = 0 ‘ 0 — нет совпадений; 1 — совпадение найдено
‘ запускаем цикл прохода вправа от ячейки J4 до тех пор пока есть данные или не найдено совпадение
Do While ps.Range(«J4»).Offset(0, i) > 0
‘ если нашлось совпадение по дате — присваиваем переменной da значение 1 и выходим из цикла
If ps.Range(«J4»).Offset(0, i) = mydate Then
da = 1
Exit Do
End If
‘ увеличиваем на 1 чтобы проверить следующую ячейку на равенство
i = i + 1
Loop
‘ если нет столбца с выбранной датой — добавляем новый
If da = 0 Then
i = 1
‘ добавляем новый столбец между столбцами J и K
Columns(«K:K»).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
‘ записываем в шапку добавленного столбца выбранную в UserForm1 дату
ps.Range(«J4»).Offset(0, 1) = mydate
‘ форматируем шапку добавленного столбца в виде «01.01.20»
ps.Range(«J4»).Offset(0, 1).NumberFormat = «dd/mm/yy;@»
End If

‘ записываем в массив «Продвигаемые ключевые слова» из книги «GTD planero.ru.xlsm»
Dim arrKey() As String
j = 0
net = 0
‘ проходим по массиву до тех пор пока присутствуют ключевые слова, даже после их отсутствия 6 строк подряд
Do While ps.Range(«I5»).Offset(j, 0) > 0 Or net ‘ считаем пустые строки (чтобы при превышении 6 — выйти из цикла)
If ps.Range(«I5»).Offset(j, 0) net = net + 1
Else ‘ если нашлось ключевое слово — обнуляем счетчик пустых строк
net = 0
End If
‘ изменяем размер массива arrKey до значения j
ReDim Preserve arrKey(j)
‘ записываем в массив ключевое слово, при этом заменяем «-» на » «, переводим все в строчные буквы, удаляем пробелвы в начале и конце ключевого слова
arrKey(j) = Replace(LCase(Trim(ps.Range(«I5»).Offset(j, 0))), «-«, » «)
‘ увеличиваем счетчик на +1
j = j + 1
Loop

‘ в файле Съем позиций
‘ находим столбец «Фраза»
q = 0
‘ проходим по массиву до тех пор, пока не упремся в пустую ячейку
Do While poz.Range(«A1»).Offset(0, q) > 0
‘ если в шапке таблицы нашли столбец с наименованием «Фраза» — выходим из цикла
If poz.Range(«A1»).Offset(0, q) = «Фраза» Then
Exit Do
End If
q = q + 1
Loop
‘ находим столбец «Позиция [Ya]»
w = 0
‘ проходим по массиву до тех пор, пока не упремся в пустую ячейку
Do While poz.Range(«A1»).Offset(0, w) > 0
‘ если в шапке таблицы нашли столбец с наименованием «Позиция [Ya]» — выходим из цикла
If poz.Range(«A1»).Offset(0, w) = «Позиция [Ya]» Then
Exit Do
End If
w = w + 1
Loop
‘ создаем два массива: arrFraza для записи данных из столбца «Фраза», arrPoz для записи данных из столбца «Позиция [Ya]»
Dim arrFraza() As String
Dim arrPoz()
k = 0
‘ проходим по массиву до тех пор, пока не упремся в пустую ячейку
Do While poz.Range(«A1»).Offset(k, q) > 0
‘ изменяем размер обоих массивов до значения k
ReDim Preserve arrFraza(k)
ReDim Preserve arrPoz(k)
‘ записываем ключевое словои и его позицию в соответствующий массив
arrFraza(k) = poz.Range(«A1»).Offset(k, q)
arrPoz(k) = poz.Range(«A1»).Offset(k, w)
k = k + 1
Loop

‘ проходим по массивам — находим соответствия и записываем данные, выделяем их цветом в зависимости от предыдущих записей
h = 0
‘ проходим по массиву до тех пор, пока переменная h не превысит размер массива arrKey
Do While h l = 0
‘ проходим по массиву до тех пор, пока переменная l не превысит размер массива arrFraza
Do While l ‘ если значение обоих массивов совпадает
If arrKey(h) = arrFraza(l) Then
‘ если позиция меньше или равно нулю (т.е. отсутствует в поиске яндекса) — записываем в ячейку нашей таблицы «нет»
If arrPoz(l) ps.Range(«J5»).Offset(h, i) = «нет»
‘ если предыдущее значение > 0 и не равно «нет» — выделяем ячейку красным (показываем что позиция просела)
If ps.Range(«J5»).Offset(h, i + 1) > 0 And ps.Range(«J5»).Offset(h, i + 1) <> «нет» Then
ps.Range(«J5»).Offset(h, i).Interior.Color = 10987519
End If
‘ если позиция больше нуля
Else
‘ записываем значение в ячейку
ps.Range(«J5»).Offset(h, i) = arrPoz(l)
‘ если предыдущее значение равно «нет», т.е. его не было в выдаче — выделяем текущее значение зеленым (показываем что позиция поднялась)
If ps.Range(«J5»).Offset(h, i + 1) = «нет» Then
ps.Range(«J5»).Offset(h, i).Interior.Color = 11534247
‘ если предыдущее значение число
Else
‘ если текущая позиция < предыдущей позиции (т.е. выше в выдаче) - выделяем текущее значение зеленым (показываем что позиция поднялась)
If ps.Range(«J5»).Offset(h, i) < ps.Range("J5").Offset(h, i + 1) Then
ps.Range(«J5»).Offset(h, i).Interior.Color = 11534247
‘ если текущая позиция > или = предыдущей позиции
Else
‘ если текущая позиция > предыдущей позиции (т.е. ниже в выдаче) — выделяем текущее значение красным (показываем что позиция просела)
If ps.Range(«J5»).Offset(h, i) > ps.Range(«J5»).Offset(h, i + 1) Then
ps.Range(«J5»).Offset(h, i).Interior.Color = 10987519
End If
‘ если текущая позиция = предыдущей позиции (т.е. не изменилась) — ничего не делаем, оставляем ячейку безцветной
End If
End If
End If
End If
l = l + 1
Loop
h = h + 1
Loop
End Function

На итог получилась картина следующего вида:

Итоговый вариант автоматического переноса данных

Теперь копирование позиций напротив соответствующего ключевого слова происходит автоматически, при этом сравниваются с предыдущими значениями этих же позиций, и выделяются цветом: красным – в случае проседания позиции, зеленым – в случае улучшения.

После реализации данного макроса, отпала необходимость каждый раз вручную или с использованием встроенных в эксель функций, например ВПР(), заниматься сопоставлением. Сейчас это делается автоматически в течение одной секунды, по нажатию кнопки «Заполнить позиции страниц в выдаче».

Как перенести данные из одной таблицы excel в другую по совпадению

А здравствуйте.
Посмотрите пожалуйста пример. Мне надо, чтоб при совпадении наименования данными из второй таблицы заполнились соответствующие строки первой таблицы. Помогите, пожалуйста. Не могу сам.

Прикрепленные файлы

• Пример.xls (26 КБ)

Пользователь
Сообщений: 512 Регистрация: 06.05.2020
24.03.2022 21:41:04
Добрый вечер, сделал через ВПР.
Прикрепленные файлы

• Пример.xls (47 КБ)

Изменено: DJMC — 24.03.2022 21:51:32
Пользователь
Сообщений: 43 Регистрация: 25.03.2015
24.03.2022 22:23:26

В строках несовпадающих по наименованию ячейках прописывается #Н/Д. Хотелось бы чтоб ячейки были пустые.

Пользователь
Сообщений: 14577 Регистрация: 01.01.1970
24.03.2022 22:26:52

=еслиошибка(. всяхерня;»»)
главное в этой ситуации понимать разницу межу пустой ячейкой и ячейкой с «»

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

Пользователь
Сообщений: 43 Регистрация: 25.03.2015
24.03.2022 22:31:03

Цитата
написал: главное в этой ситуации понимать разницу межу пустой ячейкой и ячейкой с «»

Это я понимаю.
Пользователь
Сообщений: 43 Регистрация: 25.03.2015
24.03.2022 22:36:14

Цитата
написал: =еслиошибка(. всяхерня;»»)

Сработало.
Всем спасибо.
За помощь.
Пользователь
Сообщений: 43 Регистрация: 25.03.2015
24.03.2022 22:48:15

А если уж совсем обнаглеть и усложнить задачу.
Если таблиц с данными не одна, а несколько. (вторая, третья, четвертая)
Можно решить?
Добавил проблем в пример.

Прикрепленные файлы

• Пример.xlsx (11.1 КБ)

Пользователь
Сообщений: 14577 Регистрация: 01.01.1970
24.03.2022 22:49:59

не знаю как вам эта тема, но вы сделали мой вечер
возможно мой вечер, сделал волейбол под открытым небом и небольшое количество алкоголя после него, но ваша реакция на мои скромные усилия — это песня!

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

Пользователь
Сообщений: 14577 Регистрация: 01.01.1970
24.03.2022 22:58:03

для того чтобы получить решение — обнаглеть мало, нужно обьяснить задачу
файл смотрел, (он у меня открыт сейчас) задачу не понял(((

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

Пользователь
Сообщений: 43 Регистрация: 25.03.2015
25.03.2022 00:01:42

Ну вот есть четыре таблицы. Надо всю информации собрать в одну. В последнем примере в таблицу ОДИН перекочевала информация из таблицы ДВА. (благодаря вашим усилиям). Надо дополнить таблицу ОДИН информацией из таблиц ТРИ и Четыре. Так понятно?

Пользователь
Сообщений: 14577 Регистрация: 01.01.1970
25.03.2022 01:49:28

=ИНДЕКС($A$1:$Y$6;СУММПРОИЗВ(($I$2:$Y$6=$A3)*СТРОКА($I$2:$Y$6));СУММПРОИЗВ(($I$2:$Y$6=$A3)*СТОЛБЕЦ($I$2:$Y$6))+СТОЛБЕЦ(A3))

тянем вправо и вниз

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

Пользователь
Сообщений: 43 Регистрация: 25.03.2015
25.03.2022 02:57:18
Да как так-то.
Пользователь
Сообщений: 14577 Регистрация: 01.01.1970
25.03.2022 02:58:52
это просто
одна задача — одна формула

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

Страницы: 1
Читают тему

© Николай Павлов, Planetaexcel, 2006-2023
info@planetaexcel.ru

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

ООО «Планета Эксел» ИНН 7735603520 ОГРН 1147746834949

ИП Павлов Николай Владимирович ИНН 633015842586 ОГРНИП 310633031600071

Автоматический перенос данных из одной таблицы в другую в программе Excel.

Приведу три способа Автоматического переноса данных с одного листа программы «Эксель» в другой.

Первый, самый простой и примитивный способ связи двух таблиц на разных листах документа -вставка данных при помощи опции специальной вставки.

Рассмотрим, как соединить две таблицы по шагам.

Первый шаг.

Необходимо выделить ту таблицу, из которой будут транслироваться данные во вторую таблицу.

Второй шаг.

Копировать информацию сочетанием клавиш ctrl+C или вызвав контекстное меню правой кнопкой мыши и кликнув по пункту меню «Копировать»

Третий шаг.

Перейти на лист документа «Excel», в который Вы планируете транслировать информацию из первой таблицы.

Четвертый шаг.

Поставить курсор в первую (левую верхнюю) ячейку таблицы и выбрать в меню «Вставка» пункт «Вставить связь». В некоторых версиях программы «Excel» этот пункт находится в меню «Специальная вставка»

После вставки связи следует отформатировать вид ячеек – привести их к надлежащему виду.

Второй способ переноса данных из одной таблицы в другую — это использование сводных таблиц в программе «Excel».

При использовании данного метода роль второй таблицы («реципиента») играет сама сводная таблица.

При клике правой кнопкой мыши по сводной таблице и нажатии на пункт «Обновить» сводная таблица автоматически перенесет все данные из связанного массива информации («таблицы донора»).

О том, как в «Эксель» создавать сводные таблицы подробно написано в статье:

Как делать сводные таблицы в программе «Excel» и для чего они нужны.

Третий способ самый эффективный и наиболее автоматизированный — это использование меню надстройки «Power Query».

Правда нужно отметить, что этот способ подходит только пользователям Excel 2016 и пользователям Excel 2013и выше с установленной надстройкой «Power Query».

Смысл способа в следующем:

Необходимо открыть вкладку «Power Query». В разделе «Данные Excel» нажимаем кнопку (пиктограмму) «Из таблицы».

Далее нужно выбрать диапазон ячеек, из которых нужно «притянуть» информацию и нажимаем «Ок».

После выбора области данных появится окно настройки вида новой таблицы. В этом окне Вы можете настроить последовательность вывода столбцов и удалить ненужные столбцы.

После настройки вида таблицы нажмите кнопку «Закрыть и загрузить»

Обновление полученной таблицы происходит кликом правой кнопки мыши по названию нужного запроса в правой части листа (список «Запросы книги»). После клика правой кнопкой мыши в выпадающем контекстном меню следует нажать на пункт «Обновить»

Перенос данных из одного листа одной таблицы в создаваемые листы другой таблицы

Подскажите пожалуйста как написать макрос в Excel для переноса данных из одного листа одной таблицы в создаваемые листы другой таблицы. Условия такие: есть таблица (Test), имеющая один лист (Лист1) с данными в трех столбцах, необходимо перенести информацию из ячеек столбцов «В» и «С» в другую таблицу (Nado), таким образом что ячейки первого столбца «А» первой таблицы (Test) должны стать названиями листов второй таблицы (Nado), при совпадении значений ячеек первого столбца «А» новая страница не должна создаваться, строки переносятся только на тот лист, который имеет название первой ячейки строки.

вариант разноса по листам

Sub fa() Dim r As Long, rr As Long r = Range("A5000").End(xlUp).Row Dim i As Long Dim s As Worksheet For i = 1 To r If i = 1 Then Set s = Sheets.Add(After:=Sheets(Sheets.Count)) s.Name = Sheets(1).Cells(i, 1) Sheets(1).Range("B" & i & ":C" & i).Copy s.Cells(1, 1).PasteSpecial rr = 2 ElseIf Sheets(1).Cells(i - 1, 1) <> Sheets(1).Cells(i, 1) Then Set s = Sheets.Add(After:=Sheets(Sheets.Count)) s.Name = Sheets(1).Cells(i, 1) Sheets(1).Range("B" & i & ":C" & i).Copy s.Cells(1, 1).PasteSpecial rr = 2 Else Sheets(1).Range("B" & i & ":C" & i).Copy s.Cells(rr, 1).PasteSpecial rr = rr + 1 End If Next Set s = Nothing End Sub

Похожие статьи

• Ping из VBA
• Progress bar или индикация выполнения макроса в Microsoft Office Excel
• Запретить ввод пробелов в ячейки Excel
• Массовое переименование label на форме
• Вынести часть текста из многострочной ячейки по условию (Excel)
• Копирование данных в Excel «отталкиваясь» от последней заполненой строки
• Вставка данных в Excel после последней заполненной ячейки
• Как в Excel посчитать количество дней, прошедших с заданного числа
• Копирование данных «отталкиваясь» от последней заполненной строки Excel
• Как вытащить URL адрес из формулы с гиперссылкой в Excel