Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Поиск всех значений по условию из одной таблицы в другой. - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск всех значений по условию из одной таблицы в другой. (Макросы/Sub)
Поиск всех значений по условию из одной таблицы в другой.
ASASSIN Дата: Воскресенье, 03.10.2021, 05:41 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Добрый день, уважаемые форумчане. Суть вопроса в следующем В общем каждый день присылают несколько файлов с обновлённой информацией по каждой линии (столбец E:E файл сводник). Конкретно интересуют столбцы (файл СВОДНИК- T:T , U:U , AF:AF , AG:AG , AL:AL , AM:AM дата и статус). Мне нужно в мою таблицу (Insulation LOG) перетягивать статусы и даты с таблицы (СВОДНИК) по критерию номера линии (столбец E:E). Формульные варианты не подходят так как информации очень много. Спасибо. Использую следующий код для поиска значений в столбце E из таблицы Insulation log, в таблице Сводник, и при нахождении скопировать значение из столбца со статусами U:U в таблицу Insulation log. Как не пробовал, результат получается разный либо 2 строки целиком копируются либо ни одной
[vba]
Код
Sub poisk_v()
Dim WbFROM, WbTO As Excel.Workbook
Dim ShFROM, ShTO As Excel.Worksheet
Dim RFound As Range
Dim strSelect, FirstFind As String
Dim SPath As String
Application.ScreenUpdating = False
Application.EnableEvents = False

SPath = "C:\Users\HP-PK\Desktop\Ñåòåâàÿ ïàïêà\2. ÎÁÙ. ÑÂÎÄÍÈÊ Ô-2.xlsb"
Set WbFROM = Workbooks.Open(SPath)
Set ShFROM = WbFROM.Worksheets("Main")
Set WbTO = ThisWorkbook
Set ShTO = ThisWorkbook.Worksheets("LOG")

strSelect = Range("E2:E50000").Value

With ShFROM
Set RFound = .Columns(5).Find(strSelect, LookIn:=xlValues)
If Not RFound Is Nothing Then
FirstFind = RFound.Address
Do
.Range(.Cells(RFound.Row, 1), .Cells(RFound.Row, _
.Cells(RFound.Row, .Columns.Count).End(xlToLeft).Column)).Copy
ShTO.Cells(ShTO.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial Paste:=xlPasteAll
Set RFound = .Columns(20).Find(strSelect, LookIn:=xlValues, After:=.Range(RFound.Address))
Loop While FirstFind <> RFound.Address
End If
End With
WbFROM.Close
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
[/vba]
К сообщению приложен файл: Insulation_LOG.xlsx (10.5 Kb) · 8217155.xlsx (11.5 Kb)


Сообщение отредактировал ASASSIN - Воскресенье, 03.10.2021, 07:19
 
Ответить
СообщениеДобрый день, уважаемые форумчане. Суть вопроса в следующем В общем каждый день присылают несколько файлов с обновлённой информацией по каждой линии (столбец E:E файл сводник). Конкретно интересуют столбцы (файл СВОДНИК- T:T , U:U , AF:AF , AG:AG , AL:AL , AM:AM дата и статус). Мне нужно в мою таблицу (Insulation LOG) перетягивать статусы и даты с таблицы (СВОДНИК) по критерию номера линии (столбец E:E). Формульные варианты не подходят так как информации очень много. Спасибо. Использую следующий код для поиска значений в столбце E из таблицы Insulation log, в таблице Сводник, и при нахождении скопировать значение из столбца со статусами U:U в таблицу Insulation log. Как не пробовал, результат получается разный либо 2 строки целиком копируются либо ни одной
[vba]
Код
Sub poisk_v()
Dim WbFROM, WbTO As Excel.Workbook
Dim ShFROM, ShTO As Excel.Worksheet
Dim RFound As Range
Dim strSelect, FirstFind As String
Dim SPath As String
Application.ScreenUpdating = False
Application.EnableEvents = False

SPath = "C:\Users\HP-PK\Desktop\Ñåòåâàÿ ïàïêà\2. ÎÁÙ. ÑÂÎÄÍÈÊ Ô-2.xlsb"
Set WbFROM = Workbooks.Open(SPath)
Set ShFROM = WbFROM.Worksheets("Main")
Set WbTO = ThisWorkbook
Set ShTO = ThisWorkbook.Worksheets("LOG")

strSelect = Range("E2:E50000").Value

With ShFROM
Set RFound = .Columns(5).Find(strSelect, LookIn:=xlValues)
If Not RFound Is Nothing Then
FirstFind = RFound.Address
Do
.Range(.Cells(RFound.Row, 1), .Cells(RFound.Row, _
.Cells(RFound.Row, .Columns.Count).End(xlToLeft).Column)).Copy
ShTO.Cells(ShTO.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial Paste:=xlPasteAll
Set RFound = .Columns(20).Find(strSelect, LookIn:=xlValues, After:=.Range(RFound.Address))
Loop While FirstFind <> RFound.Address
End If
End With
WbFROM.Close
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
[/vba]

Автор - ASASSIN
Дата добавления - 03.10.2021 в 05:41
doober Дата: Воскресенье, 03.10.2021, 13:00 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 947
Репутация: 323 ±
Замечаний: 0% ±

Excel 2010
Так можно.




Сообщение отредактировал doober - Воскресенье, 03.10.2021, 13:02
 
Ответить
СообщениеТак можно.

Автор - doober
Дата добавления - 03.10.2021 в 13:00
ASASSIN Дата: Воскресенье, 03.10.2021, 16:44 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Гениально!!! Спасибо большое вам.
 
Ответить
СообщениеГениально!!! Спасибо большое вам.

Автор - ASASSIN
Дата добавления - 03.10.2021 в 16:44
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск всех значений по условию из одной таблицы в другой. (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!