Добрый день Уважаемые форумчане. Пытаюсь два дня найти решение в нэте, но пока никак... Своих знаний не хватает, по этому обращаюсь к Вам. Есть таблица с исходными данными (вкладка Invoices), нужно на отдельном листе (Data) при выборе одной из позиций из списка (ячейка B1), что бы в колонку "С" он вертикально выводил список всех строчек с этой позиции из списка исходных данных, рядом подставлял все значения, находящиеся справа от этих позиций.
пример того, как это должно быть, показан на вкладке Example (тока там без форму, естественно... )
заранее Огромное СПАСИБО!
Добрый день Уважаемые форумчане. Пытаюсь два дня найти решение в нэте, но пока никак... Своих знаний не хватает, по этому обращаюсь к Вам. Есть таблица с исходными данными (вкладка Invoices), нужно на отдельном листе (Data) при выборе одной из позиций из списка (ячейка B1), что бы в колонку "С" он вертикально выводил список всех строчек с этой позиции из списка исходных данных, рядом подставлял все значения, находящиеся справа от этих позиций.
пример того, как это должно быть, показан на вкладке Example (тока там без форму, естественно... )
pabchek, Спасибо большое, но такой вариант я уже рассматривал и он, к сожалению, не подойдет для моей задачи ((( Дело в том, что эти полученные данные далее используются другой программой, и она не умеет работать, если сверху от самих данных есть какие либо заголовки, фильтры и т.п. Ей нужно, что бы с самой первой строчки шли именно данные.
pabchek, Спасибо большое, но такой вариант я уже рассматривал и он, к сожалению, не подойдет для моей задачи ((( Дело в том, что эти полученные данные далее используются другой программой, и она не умеет работать, если сверху от самих данных есть какие либо заголовки, фильтры и т.п. Ей нужно, что бы с самой первой строчки шли именно данные.Alexushu
Alexushu, из персональной коллекции Макрос ищет все вхождения одного и более искомых значений [vba]
Код
Option Explicit
Sub SearchByList() '' Author: boa '' Written: 20.10.2017 '' Edited: ' Description: Берет данные из заданного диапазона искомых значений(Словаря) и сравнивает их со списком значений, ' если находит совпадения, то переносит все уникальные значения из заданного столбца ' и сопоставленное ему значение из Словаря в новую книгу.
Dim MyList As Range 'Список искомых значений Dim MyRange As Range 'Диапазон для поиска Dim SearchColumn As Integer 'колонка в которой ищем совпадения Dim ZnachColumn As Integer 'колонка из которой нужно вывести значения Dim iRow&, V$, Znach As Variant Dim strCaption$, strLabel$
On Error GoTo Proverka strCaption = "Поиск уникальных значений по списку" strLabel = "Введите ссылку на список значений которые надо найти(Словарь)." & vbCrLf & _ "Будут учитываться только видимы значения из выбранного диапазона." Set MyList = Application.InputBox(Prompt:=strLabel, Title:=strCaption, Type:=8) strLabel = "Введите ссылку на диапазон содержащий искомые значения и колонку для сопоставления со Словарем." Set MyRange = Application.InputBox(Prompt:=strLabel, Title:=strCaption, Type:=8) If Not MyRange Is Nothing Then SearchColumn = MyRange.Columns.Count strLabel = "Введите номер колонки от 1 до " & SearchColumn & " в выбранном диапазоне, по которой должен быть произведен поиск значений из Словаря." SearchColumn = Application.InputBox(Prompt:=strLabel, Title:=strCaption, Default:=SearchColumn, Type:=1)
strLabel = "Введите номер колонки в массиве из которой надо вывести найденный результат." & vbCrLf & _ "Если номер колонки не вводить(нажать ""Отмена""), то в результат будет выведена вся строка из выделенного диапазона." ZnachColumn = Application.InputBox(Prompt:=strLabel, Title:=strCaption, Type:=1) Proverka: If MyList Is Nothing Or MyRange Is Nothing Or SearchColumn < 1 Then _ MsgBox "Не введены все обязательные параметры для поиска значений.", vbCritical, "": Exit Sub Dim MeTime As Date, Start!, sMsg$ MeTime = Time Start! = Timer
Dim i&, a As Range, DicSearch As Object, Dic As Object
Set DicSearch = CreateObject("Scripting.Dictionary") Set Dic = CreateObject("Scripting.Dictionary") On Error Resume Next For Each a In MyList 'Список искомых значений If a.Rows.Hidden = False Then DicSearch.Add CStr(a.Value), a.Value Next a
For i = 1 To MyRange.Rows.Count 'Список найденных значений If DicSearch.Exists(CStr(MyRange.Cells(i, SearchColumn).Value)) Then If ZnachColumn > 0 Then V = CStr(MyRange.Cells(i, ZnachColumn).Value) Else V = i Dic.Add V, CStr(MyRange.Cells(i, SearchColumn).Value) End If Next i
With Workbooks.Add(xlWBATWorksheet).Worksheets(1) 'вывод результатов .Cells(1, 1).Value = "Значения из списка" .Cells(1, 2).Value = "Найденные значение " & Dic.Count iRow = 2 If ZnachColumn > 0 Then .Range(.Cells(iRow, 1), .Cells(Dic.Count + 1, 2)).Value = Application.Transpose(Array(Dic.Items, Dic.Keys)) Else .Range(.Cells(iRow, 1), .Cells(Dic.Count + 1, 1)).Value = Application.Transpose(Array(Dic.Items)) For Each Znach In Dic .Range(.Cells(iRow, 2), .Cells(iRow, MyRange.Columns.Count + 1)).Value = MyRange.Rows(Znach).Value iRow = iRow + 1 Next End If .UsedRange.EntireColumn.AutoFit End With
Alexushu, из персональной коллекции Макрос ищет все вхождения одного и более искомых значений [vba]
Код
Option Explicit
Sub SearchByList() '' Author: boa '' Written: 20.10.2017 '' Edited: ' Description: Берет данные из заданного диапазона искомых значений(Словаря) и сравнивает их со списком значений, ' если находит совпадения, то переносит все уникальные значения из заданного столбца ' и сопоставленное ему значение из Словаря в новую книгу.
Dim MyList As Range 'Список искомых значений Dim MyRange As Range 'Диапазон для поиска Dim SearchColumn As Integer 'колонка в которой ищем совпадения Dim ZnachColumn As Integer 'колонка из которой нужно вывести значения Dim iRow&, V$, Znach As Variant Dim strCaption$, strLabel$
On Error GoTo Proverka strCaption = "Поиск уникальных значений по списку" strLabel = "Введите ссылку на список значений которые надо найти(Словарь)." & vbCrLf & _ "Будут учитываться только видимы значения из выбранного диапазона." Set MyList = Application.InputBox(Prompt:=strLabel, Title:=strCaption, Type:=8) strLabel = "Введите ссылку на диапазон содержащий искомые значения и колонку для сопоставления со Словарем." Set MyRange = Application.InputBox(Prompt:=strLabel, Title:=strCaption, Type:=8) If Not MyRange Is Nothing Then SearchColumn = MyRange.Columns.Count strLabel = "Введите номер колонки от 1 до " & SearchColumn & " в выбранном диапазоне, по которой должен быть произведен поиск значений из Словаря." SearchColumn = Application.InputBox(Prompt:=strLabel, Title:=strCaption, Default:=SearchColumn, Type:=1)
strLabel = "Введите номер колонки в массиве из которой надо вывести найденный результат." & vbCrLf & _ "Если номер колонки не вводить(нажать ""Отмена""), то в результат будет выведена вся строка из выделенного диапазона." ZnachColumn = Application.InputBox(Prompt:=strLabel, Title:=strCaption, Type:=1) Proverka: If MyList Is Nothing Or MyRange Is Nothing Or SearchColumn < 1 Then _ MsgBox "Не введены все обязательные параметры для поиска значений.", vbCritical, "": Exit Sub Dim MeTime As Date, Start!, sMsg$ MeTime = Time Start! = Timer
Dim i&, a As Range, DicSearch As Object, Dic As Object
Set DicSearch = CreateObject("Scripting.Dictionary") Set Dic = CreateObject("Scripting.Dictionary") On Error Resume Next For Each a In MyList 'Список искомых значений If a.Rows.Hidden = False Then DicSearch.Add CStr(a.Value), a.Value Next a
For i = 1 To MyRange.Rows.Count 'Список найденных значений If DicSearch.Exists(CStr(MyRange.Cells(i, SearchColumn).Value)) Then If ZnachColumn > 0 Then V = CStr(MyRange.Cells(i, ZnachColumn).Value) Else V = i Dic.Add V, CStr(MyRange.Cells(i, SearchColumn).Value) End If Next i
With Workbooks.Add(xlWBATWorksheet).Worksheets(1) 'вывод результатов .Cells(1, 1).Value = "Значения из списка" .Cells(1, 2).Value = "Найденные значение " & Dic.Count iRow = 2 If ZnachColumn > 0 Then .Range(.Cells(iRow, 1), .Cells(Dic.Count + 1, 2)).Value = Application.Transpose(Array(Dic.Items, Dic.Keys)) Else .Range(.Cells(iRow, 1), .Cells(Dic.Count + 1, 1)).Value = Application.Transpose(Array(Dic.Items)) For Each Znach In Dic .Range(.Cells(iRow, 2), .Cells(iRow, MyRange.Columns.Count + 1)).Value = MyRange.Rows(Znach).Value iRow = iRow + 1 Next End If .UsedRange.EntireColumn.AutoFit End With
Здравствуйте! boa, макрос отличный. Могли ли мне помочь немного его изменить в части 2х условий: 1. ввод ссылки на диапазон сделать так, чтобы можно было выбрать любую книгу Exel, в которой содержится один лист с заполненными колонками (диапазон можно было бы править в макросе. Т.е. по умолчанию поиск происходил бы с них. 2. выводить результат не только 1-ой или всем колонкам, а с возможностью по 2м,3м,4м колонкам и т.п.. Т.е. указать в макросе 2&3&4 или 3&4&2&8 и т.п. с возможностью изменить.
Здравствуйте! boa, макрос отличный. Могли ли мне помочь немного его изменить в части 2х условий: 1. ввод ссылки на диапазон сделать так, чтобы можно было выбрать любую книгу Exel, в которой содержится один лист с заполненными колонками (диапазон можно было бы править в макросе. Т.е. по умолчанию поиск происходил бы с них. 2. выводить результат не только 1-ой или всем колонкам, а с возможностью по 2м,3м,4м колонкам и т.п.. Т.е. указать в макросе 2&3&4 или 3&4&2&8 и т.п. с возможностью изменить.RSerg
Здравствуйте, по 1-му пункту не вижу проблем. Инпутбох позволяет указать диапазон в любой книге. а по 2-му - рассплитуйте ZnachColumn по нужному разделителю, только предварительно измените формат переменной на As Variant, и выводите по номерам колонок ))
Здравствуйте, по 1-му пункту не вижу проблем. Инпутбох позволяет указать диапазон в любой книге. а по 2-му - рассплитуйте ZnachColumn по нужному разделителю, только предварительно измените формат переменной на As Variant, и выводите по номерам колонок ))boa
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
)
