Доброго времени суток. Знаю VBA не так углублено, чтобы решить задачу и решил попросить помощи здесь. Задача следующая: есть 2 файла. В 1-ом файле есть все выполненные транзакции по нескольким терминалам. Во 2-ом файле с несколькими листами транзакции конкретного терминала. Нужно найти совпадения столбцов даты и суммы(допустим что в 1-ом файле это столбцы G и F, а во 2-ом B и С) из 1 файла во 2(на всех листах) и найденные совпадения записать на отдельный лист 1-го. Спасибо.
Доброго времени суток. Знаю VBA не так углублено, чтобы решить задачу и решил попросить помощи здесь. Задача следующая: есть 2 файла. В 1-ом файле есть все выполненные транзакции по нескольким терминалам. Во 2-ом файле с несколькими листами транзакции конкретного терминала. Нужно найти совпадения столбцов даты и суммы(допустим что в 1-ом файле это столбцы G и F, а во 2-ом B и С) из 1 файла во 2(на всех листах) и найденные совпадения записать на отдельный лист 1-го. Спасибо.Noise
Noise, - Прочитайте Правила форума - Приложите файл с исходными данными и желаемым результатом (можно вручную) в формате Excel размером до 100кб согласно п.3 Правил форума
Noise, - Прочитайте Правила форума - Приложите файл с исходными данными и желаемым результатом (можно вручную) в формате Excel размером до 100кб согласно п.3 Правил форумакитин
Не судите очень строго:я пытаюсь научиться ЯД 41001877306852
Dim MyArray As Range, NewMyArray, Dic As Object, sKey$ Dim a As Range, sh As Worksheet, iRow&
Set Dic = CreateObject("Scripting.Dictionary")
ThisWorkbook.Worksheets("Лист2").Cells.Clear Set MyArray = ThisWorkbook.Worksheets("Лист1").Cells(1, 1).CurrentRegion On Error Resume Next 'что бы не останавливалось на ошибке For Each a In MyArray.Rows sKey = CStr(CDate(a.Cells(1).Value)) & CStr(a.Cells(7).Value) Dic.Add sKey, sKey Next a With Workbooks("4163150.xlsx") 'вторая книга. Должна быть открыта For Each sh In .Worksheets Set MyArray = sh.Cells(1, 1).CurrentRegion.Offset(1) For Each a In MyArray.Rows sKey = CStr(CDate(a.Cells(2).Value)) & CStr(a.Cells(5).Value) If Dic.Exists(sKey) Then 'если такой ключ уже есть, то переносим строку iRow = iRow + 1 a.Copy ThisWorkbook.Worksheets("Лист2").Cells(iRow, 1) End If Next a Next sh End With End Sub
[/vba]
Здравствуйте, Noise, В стандартный модуль 1-й книги [vba]
Dim MyArray As Range, NewMyArray, Dic As Object, sKey$ Dim a As Range, sh As Worksheet, iRow&
Set Dic = CreateObject("Scripting.Dictionary")
ThisWorkbook.Worksheets("Лист2").Cells.Clear Set MyArray = ThisWorkbook.Worksheets("Лист1").Cells(1, 1).CurrentRegion On Error Resume Next 'что бы не останавливалось на ошибке For Each a In MyArray.Rows sKey = CStr(CDate(a.Cells(1).Value)) & CStr(a.Cells(7).Value) Dic.Add sKey, sKey Next a With Workbooks("4163150.xlsx") 'вторая книга. Должна быть открыта For Each sh In .Worksheets Set MyArray = sh.Cells(1, 1).CurrentRegion.Offset(1) For Each a In MyArray.Rows sKey = CStr(CDate(a.Cells(2).Value)) & CStr(a.Cells(5).Value) If Dic.Exists(sKey) Then 'если такой ключ уже есть, то переносим строку iRow = iRow + 1 a.Copy ThisWorkbook.Worksheets("Лист2").Cells(iRow, 1) End If Next a Next sh End With End Sub
boa, огромное спасибо за ответ. Если не затруднит....можно ли записать совпадение не в новый лист 1-го файла, а в тот же лист(1-ый), только взяв строку из 2-го и подставить ее именно напротив совпадения в 1-ом?
boa, огромное спасибо за ответ. Если не затруднит....можно ли записать совпадение не в новый лист 1-го файла, а в тот же лист(1-ый), только взяв строку из 2-го и подставить ее именно напротив совпадения в 1-ом?Noise
Сообщение отредактировал Noise - Понедельник, 24.06.2019, 14:16
Dim MyArray As Range, NewMyArray, Dic As Object, sKey$ Dim a As Range, sh As Worksheet ', iRow&
Set Dic = CreateObject("Scripting.Dictionary")
ThisWorkbook.Worksheets("Лист2").Cells.Clear Set MyArray = ThisWorkbook.Worksheets("Лист1").Cells(1, 1).CurrentRegion On Error Resume Next 'что бы не останавливалось на ошибке For Each a In MyArray.Rows sKey = CStr(CDate(a.Cells(1).Value)) & CStr(a.Cells(7).Value) Dic.Add sKey, a.Row Next a With Workbooks("4163150.xlsx") 'книга должна быть открыта For Each sh In .Worksheets Set MyArray = sh.Cells(1, 1).CurrentRegion.Offset(1) For Each a In MyArray.Rows sKey = CStr(CDate(a.Cells(2).Value)) & CStr(a.Cells(5).Value) If Dic.Exists(sKey) Then 'если такой ключ уже есть, то переносим строку ' iRow = iRow + 1 a.Copy ThisWorkbook.Worksheets("Лист1").Cells(Dic(sKey), 10) End If Next a Next sh End With End Sub
Dim MyArray As Range, NewMyArray, Dic As Object, sKey$ Dim a As Range, sh As Worksheet ', iRow&
Set Dic = CreateObject("Scripting.Dictionary")
ThisWorkbook.Worksheets("Лист2").Cells.Clear Set MyArray = ThisWorkbook.Worksheets("Лист1").Cells(1, 1).CurrentRegion On Error Resume Next 'что бы не останавливалось на ошибке For Each a In MyArray.Rows sKey = CStr(CDate(a.Cells(1).Value)) & CStr(a.Cells(7).Value) Dic.Add sKey, a.Row Next a With Workbooks("4163150.xlsx") 'книга должна быть открыта For Each sh In .Worksheets Set MyArray = sh.Cells(1, 1).CurrentRegion.Offset(1) For Each a In MyArray.Rows sKey = CStr(CDate(a.Cells(2).Value)) & CStr(a.Cells(5).Value) If Dic.Exists(sKey) Then 'если такой ключ уже есть, то переносим строку ' iRow = iRow + 1 a.Copy ThisWorkbook.Worksheets("Лист1").Cells(Dic(sKey), 10) End If Next a Next sh End With End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
