Коллеги, друзья, сочувствующие! Помогите дебилу, в приложении архив с двумя файлами, "пример классификатора.xlsx" как база, "файл 2.xlsx" как файл с макросом, запускаем его. При нажатии на стрелку, запускается макрос, вводим номер столбца из классификатора, и выбираем сам файл с классификатором. В итоге получается аналог ВПР. Всего макрос рассчитан на 4 столбца, а нужно получить неограниченное кол-во столбцов, т.к. классификатор будет всегда разный, иметь и по 10-20 столбцов. Кто может внести изменения?
Коллеги, друзья, сочувствующие! Помогите дебилу, в приложении архив с двумя файлами, "пример классификатора.xlsx" как база, "файл 2.xlsx" как файл с макросом, запускаем его. При нажатии на стрелку, запускается макрос, вводим номер столбца из классификатора, и выбираем сам файл с классификатором. В итоге получается аналог ВПР. Всего макрос рассчитан на 4 столбца, а нужно получить неограниченное кол-во столбцов, т.к. классификатор будет всегда разный, иметь и по 10-20 столбцов. Кто может внести изменения?Лойер
Макрос подтягивает по одному столбцу. Вам нужно просто увеличить диапазон выбора с 4-х до 20? Или чтоб подтягивал сразу все 20-ть? Если 1-е, то удалите строку: [vba]
Код
If clmn < 2 Or clmn > 5 Then MsgBox "Нет такого столбца", 64: Exit Sub
[/vba] и поменяйте [vba]
Код
x = .Range("A2:E" & .Cells(Rows.Count, 1).End(xlUp).Row).Value на x = .Range("A2:z" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
Макрос подтягивает по одному столбцу. Вам нужно просто увеличить диапазон выбора с 4-х до 20? Или чтоб подтягивал сразу все 20-ть? Если 1-е, то удалите строку: [vba]
Код
If clmn < 2 Or clmn > 5 Then MsgBox "Нет такого столбца", 64: Exit Sub
[/vba] и поменяйте [vba]
Код
x = .Range("A2:E" & .Cells(Rows.Count, 1).End(xlUp).Row).Value на x = .Range("A2:z" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
SLAVICK, огромное спасибо, теперь все как надо. Вот еще какая мысль пришла в голову, а что если классификатор будет находиться не в другом файле, а допустим на новом листе, можно ли как то модернизировать под это макрос? Понятно, что ВПР будет здесь уместнее, но интересует именно макрос.
SLAVICK, огромное спасибо, теперь все как надо. Вот еще какая мысль пришла в голову, а что если классификатор будет находиться не в другом файле, а допустим на новом листе, можно ли как то модернизировать под это макрос? Понятно, что ВПР будет здесь уместнее, но интересует именно макрос.Лойер
Вообще то Впр прекрасно справляется и с 1-й задачей :D если хотите использовать Ваш макрос: удалите блок [vba]
Код
With Application.FileDialog(msoFileDialogFilePicker) 'классификатор .Title = "Выбираем файл-классификатор": .InitialFileName = ThisWorkbook.Path .Filters.Add "Excel", "*.xls;*.xlsx;*.xlsm", 1: .AllowMultiSelect = False If .Show = False Then Exit Sub: If .SelectedItems.Count = 0 Then Exit Sub Set wb = GetObject(.SelectedItems(1)) End With
[/vba]Добавьте строку выбора листа: [vba]
Код
i = InputBox("номер листа с информацией", , 1)
[/vba] и вместо: [vba]
Код
With wb.Sheets(1) напишите: With Sheets(i)
[/vba]
[offtop]А вообще, как по мне -этот макрос очень не удобный, и я бы использовал совсем другой алгоритм - словарь... но тема не о том.[/offtop]
Вообще то Впр прекрасно справляется и с 1-й задачей :D если хотите использовать Ваш макрос: удалите блок [vba]
Код
With Application.FileDialog(msoFileDialogFilePicker) 'классификатор .Title = "Выбираем файл-классификатор": .InitialFileName = ThisWorkbook.Path .Filters.Add "Excel", "*.xls;*.xlsx;*.xlsm", 1: .AllowMultiSelect = False If .Show = False Then Exit Sub: If .SelectedItems.Count = 0 Then Exit Sub Set wb = GetObject(.SelectedItems(1)) End With
[/vba]Добавьте строку выбора листа: [vba]
Код
i = InputBox("номер листа с информацией", , 1)
[/vba] и вместо: [vba]
Код
With wb.Sheets(1) напишите: With Sheets(i)
[/vba]
[offtop]А вообще, как по мне -этот макрос очень не удобный, и я бы использовал совсем другой алгоритм - словарь... но тема не о том.[/offtop]SLAVICK
Вообще то Впр прекрасно справляется и с 1-й задачей :D
Бесспорно, но решили попробовать макросом снизить объем файла и время "обдумывания". Очень большой объем информации, ВПР просто не справляется, все зависает на полдня. В итоге, с помощью ваших советов и корректировок объем не снизили почти, но время реагирования снизили в разы. Спасибо вам большое!
Вообще то Впр прекрасно справляется и с 1-й задачей :D
Бесспорно, но решили попробовать макросом снизить объем файла и время "обдумывания". Очень большой объем информации, ВПР просто не справляется, все зависает на полдня. В итоге, с помощью ваших советов и корректировок объем не снизили почти, но время реагирования снизили в разы. Спасибо вам большое! Лойер
SLAVICK, после тестирования этого макроса, обнаружил вот какой косяк..если в "базе" номера в первом столбце будут идти не по возрастанию, то все работает криво, что то он подтягивает, а что то нет, никакой логичности не нашел. Будьте добры, посмотрите что не так?
SLAVICK, после тестирования этого макроса, обнаружил вот какой косяк..если в "базе" номера в первом столбце будут идти не по возрастанию, то все работает криво, что то он подтягивает, а что то нет, никакой логичности не нашел. Будьте добры, посмотрите что не так?Лойер
Sub ertert() Dim wb As Object Dim x, y, z(), i&, j&, bu As Boolean Dim ubx&, lbx&, clmn& Dim dic As New Dictionary dic.CompareMode = TextCompare clmn = Application.InputBox("Введите номер столбца ", _ "Столбец для поиска", 2, Type:=1) Application.ScreenUpdating = False i = InputBox("номер листа с информацией", , 1) With Sheets(i) x = .Range("A2:z" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value 'где ищем End With 'x = Application.InputBox("выберите диапазон", , , , , , , 8) 'tm = Timer y = Range([a2], Cells(Rows.Count, 1).End(xlUp)).Value 'что ищем ReDim z(1 To UBound(y), 1 To 1)
'Заганяем массив x в словарь For i = 1 To UBound(x) If Not dic.Exists(CStr(x(i, 1))) Then dic.Add CStr(x(i, 1)), i Next 'если есть данные в словаре - записываем данные в z ReDim z(1 To UBound(y), 1 To 1)
For i = 1 To UBound(y) If dic.Exists(CStr(y(i, 1))) Then z(i, 1) = x(dic(CStr(y(i, 1))), clmn) Next
[a2].Offset(, clmn - 1).Resize(UBound(y)) = z Application.ScreenUpdating = True End Sub
[/vba] Зы если макрос не будет работать - подключите библиотеку Microsoft Scripting Runtime В tools--reference
Sub ertert() Dim wb As Object Dim x, y, z(), i&, j&, bu As Boolean Dim ubx&, lbx&, clmn& Dim dic As New Dictionary dic.CompareMode = TextCompare clmn = Application.InputBox("Введите номер столбца ", _ "Столбец для поиска", 2, Type:=1) Application.ScreenUpdating = False i = InputBox("номер листа с информацией", , 1) With Sheets(i) x = .Range("A2:z" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value 'где ищем End With 'x = Application.InputBox("выберите диапазон", , , , , , , 8) 'tm = Timer y = Range([a2], Cells(Rows.Count, 1).End(xlUp)).Value 'что ищем ReDim z(1 To UBound(y), 1 To 1)
'Заганяем массив x в словарь For i = 1 To UBound(x) If Not dic.Exists(CStr(x(i, 1))) Then dic.Add CStr(x(i, 1)), i Next 'если есть данные в словаре - записываем данные в z ReDim z(1 To UBound(y), 1 To 1)
For i = 1 To UBound(y) If dic.Exists(CStr(y(i, 1))) Then z(i, 1) = x(dic(CStr(y(i, 1))), clmn) Next
[a2].Offset(, clmn - 1).Resize(UBound(y)) = z Application.ScreenUpdating = True End Sub
[/vba] Зы если макрос не будет работать - подключите библиотеку Microsoft Scripting Runtime В tools--reference
If Not dic.Exists(CStr(x(i, 1))) Then dic.Add CStr(x(i, 1)), i
[/vba] я обычно применяю [vba]
Код
dic.item(trim(x(i, 1))) = i
[/vba] так меньше преобразований и проверок, и заодно от косяков с пробелами подстрахуетесь. Ну и при проверке тоже аналогично откидываем пробелы, можно использовать временную переменную, чтоб два раза не откидывать.
Вместо [vba]
Код
If Not dic.Exists(CStr(x(i, 1))) Then dic.Add CStr(x(i, 1)), i
[/vba] я обычно применяю [vba]
Код
dic.item(trim(x(i, 1))) = i
[/vba] так меньше преобразований и проверок, и заодно от косяков с пробелами подстрахуетесь. Ну и при проверке тоже аналогично откидываем пробелы, можно использовать временную переменную, чтоб два раза не откидывать.Hugo
У меня в процедуре ВПРа (не этой, а которой я пользуюсь) есть несколько режимов, сверки: точное соответствие, без знаков пунктуации, примерное, содержит.
Иногда нужно чтобы искало "четкое соответствие" - тогда trim - нельзя использовать. Если нужно искать без пробелов - тогда уж лучше пользоваться replace ом - например будет: "...ул. правды..." и "...ул.правды..." - трим не спасет - а реплейс поможет , а еще может быть и "...ул правды..." - тогда мой 2-й режим По поводу записи сразу dic.item(...- оно немного быстрее, но тут уже дело привычки - возьму себе на заметку попробовать - просто конструкции [vba]
Код
If ... dic.Exists ...
[/vba] мне проще для восприятия, и в коде сразу можно обрабатывать условия если False.
У меня в процедуре ВПРа (не этой, а которой я пользуюсь) есть несколько режимов, сверки: точное соответствие, без знаков пунктуации, примерное, содержит.
Иногда нужно чтобы искало "четкое соответствие" - тогда trim - нельзя использовать. Если нужно искать без пробелов - тогда уж лучше пользоваться replace ом - например будет: "...ул. правды..." и "...ул.правды..." - трим не спасет - а реплейс поможет , а еще может быть и "...ул правды..." - тогда мой 2-й режим По поводу записи сразу dic.item(...- оно немного быстрее, но тут уже дело привычки - возьму себе на заметку попробовать - просто конструкции [vba]
Код
If ... dic.Exists ...
[/vba] мне проще для восприятия, и в коде сразу можно обрабатывать условия если False.SLAVICK
Уважаемые, знатоки! Пытаюсь приспособить код указанный выше к своим условиям и глухо..(( Все работает, но если я указываю брать инфу из 13 столбца, то и последующая вставка происходит в 13 столбец, а как сделать выбор столбца для вставки (в моем случае например из первого листа нужно вставлять во второй столбец "Электроэн", а со второго листа в третий и четвертый "ГАЗ", "Вода") ? И как сделать выбор диапазона, например информация со второго листа берется с разных диапазонов (Газ, Вода)? Помогите!)
ЗЫ:Пробовал сделать это через Function.VLookup, но в этом случае почему-то часть строк (их много) не заполнялось(
Уважаемые, знатоки! Пытаюсь приспособить код указанный выше к своим условиям и глухо..(( Все работает, но если я указываю брать инфу из 13 столбца, то и последующая вставка происходит в 13 столбец, а как сделать выбор столбца для вставки (в моем случае например из первого листа нужно вставлять во второй столбец "Электроэн", а со второго листа в третий и четвертый "ГАЗ", "Вода") ? И как сделать выбор диапазона, например информация со второго листа берется с разных диапазонов (Газ, Вода)? Помогите!)
ЗЫ:Пробовал сделать это через Function.VLookup, но в этом случае почему-то часть строк (их много) не заполнялось(4zz