Страницы: 1
RSS
Макрос найти-заменить, оптимизация кода
 
Добрый день!
Есть классификатор и отчет который выдает данные + код группы артикула.
Групп 2500 фамилий 6
Каждый раз вприть муторно, написал код ( макрорекодером найти и заменить)
На самом деле 3 кода т.к. есть ограничение VBA на количество строк (бью на 3 SUB)
С небольшим отчетом все прелесно, но если строчек около или больше 1000 ... то проще открывать классификато и вприть...

Есть мысли как упростить код?
Код
Sub Klass_r1()

Application.ScreenUpdating = False
    Selection.FormulaR1C1 = "=RC[-1]"
        Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Selection.Replace What:="DAX", Replacement:="ФИО1"
        Selection.Replace What:="DAZ", Replacement:="ФИО2"
        Selection.Replace What:="DBI", Replacement:="ФИО2"
        Selection.Replace What:="DDB", Replacement:="ФИО3"
        Selection.Replace What:="DDC", Replacement:="ФИО2"
        Selection.Replace What:="DDF", Replacement:="ФИО3"
        Selection.Replace What:="DDG", Replacement:="ФИО3"
        Selection.Replace What:="DDH", Replacement:="ФИО3"
 ....
 Call klass_r2


End Sub

Sub klass_r2()



Изменено: MonsterBeer - 20.05.2015 15:58:51
Когда я ем,я глух и нем, хитер и быстр, и дьявольски умен.
 
Добрый.
Править макрос лучше на файле с расположением данных, как у Вас в оригинале.
Покажите кусок данных в файле, укажите, что на что и где надо заменить.
Мне лично пока не очень понятно... :)
Кому решение нужно - тот пример и рисует.
 
Вот коротенько...

В отчет вручную с права добавляю столбец для фамилии.
Выделяю диапозон и запускаю макрос
Изменено: MonsterBeer - 20.05.2015 15:57:37
Когда я ем,я глух и нем, хитер и быстр, и дьявольски умен.
 
да, присоединюсь к пред оратору..

если возможно получить непосредственно предмет замены(допустим, номер ячейки или как то так), то можно избежать многократного прохода по содержимому - сйчас у вас каждая строка Selection.Replace  - это цикл перебора всего содержимого, сравнения его с заданным и замены при совпадении

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

не знаю, понятно ли объяснил :)
Живи и дай жить..
 
Вводная
код - фамилия
Кодов 2500 фамилий 6.
1я мысль была макрос открывает классификатор, вприт выделенный диапзон, сохраняет как значение.
2. Засунуть в код все данные...
Пошел по второму пути....
Когда я ем,я глух и нем, хитер и быстр, и дьявольски умен.
 
Можно как-то так (я постарался подробно расписать):
Код
Sub MonsterBeer()
    Dim objC As Range
    Dim arrA()
    Dim intI As Integer
            'проверяем, чтобы в выделении не было больше одного столбца
            If Selection.Columns.Count > 1 Then
                MsgBox "В выделении не должно быть более одного столбца"
                Exit Sub
            End If
        'забираем таблицу соответствий в массив
        arrA = Range("I3:J9")
            'для каждой ячееки в выделении
            For Each objC In Selection
                'для каждого левого элемента таблицы соответствий
                For intI = LBound(arrA, 1) To UBound(arrA, 1)
                    'если элемент таблицы равен ячейке слева от текущей
                    If arrA(intI, 1) = objC.Offset(0, -1).Value Then
                        'заменяем значение текущей правым значением из таблицы соответствий
                        objC.Value = arrA(intI, 2)
                        'и выходим из цикла, переходим к следующей ячейке в выделении
                        Exit For
                    End If
                    'а если нет - проверяем следующее значение таблицы соответствий
                Next intI
            Next

End Sub
Изменено: Пытливый - 20.05.2015 16:31:29
Кому решение нужно - тот пример и рисует.
 
Код
'забираем таблицу соответствий в массив

Вопрос.
Я хотел избежать открытий таблиц классификатора
Возможно сделать некий справочник в коде?
(у меня уже реализовано)
Изменено: MonsterBeer - 20.05.2015 16:39:14
Когда я ем,я глух и нем, хитер и быстр, и дьявольски умен.
 
Можно, конечно, только как вы его будете заполнять при инициализации процедуры? Циклом забивать каждый элемент код-значение?
З.Ы. Мне кажется (пусть меня поправят), что таблицу с классификатором совершенно не обязательно открывать, нет? ПолныйПуть.имяфайла.имялиста.диапазон а?
Изменено: Пытливый - 20.05.2015 16:49:00
Кому решение нужно - тот пример и рисует.
 
Если не затрудниит, пример
Код
arrA = Range("I3:J9")

Я поправлю на свой адрес
Когда я ем,я глух и нем, хитер и быстр, и дьявольски умен.
 
Цитата
MonsterBeer написал: Есть мысли как упростить код?
Код
Sub test()
    Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
    Dim cl As Range
    Dic.CompareMode = vbTextCompare
    Dic.Add "DAX", "ФИО1"
    Dic.Add "DAZ", "ФИО2"
    Dic.Add "DBI", "ФИО2"
    Dic.Add "DDB", "ФИО3"
    Dic.Add "DDC", "ФИО2"
    Dic.Add "DDF", "ФИО3"
    Dic.Add "DDG", "ФИО"
    Dic.Add "DDH", "ФИО3"
    
    For Each cl In Selection
        If Dic.exists(cl.Value) Then cl.Value = Dic(cl.Value)
    Next cl
    Set Dic = Nothing
End Sub
Изменено: Scripter - 20.05.2015 17:16:30
 
Хммм... скорее всего, меня таки поправят....
Думаю...
Кому решение нужно - тот пример и рисует.
 
Scripter,
2500 в одном Sub()
Раньше VBA матерился...
Когда я ем,я глух и нем, хитер и быстр, и дьявольски умен.
 
вы имеете ввиду список замен?
если да то это не проблема, вынесите справочник замен в отдельный лист, пробегитесь по нему
Код
for each cl in [лист].[range]
     dic.add [что искать],[чем заменить]
next cl
наберете справочник замен, затем как в моем предыдущем сообщении пройдётесь по selection

будет достаточно быстро
Изменено: Scripter - 20.05.2015 17:34:57
 
Scripter, Да, сейчас сделаю код посмотрю на скорость...
Когда я ем,я глух и нем, хитер и быстр, и дьявольски умен.
 
Если 2500 - это список замен, да ещё и фамилии... Не придётся ли пару раз в неделю лазить в код?
Я бы держал его в текстовом файле или тут же где-то на листе (можно скрытом) - так проще его править, а по скорости и не заметите.
В словарь его, и меняем.... Как выше показали.
 
Макрос реализован в надстройке, а как мне закинуть данные справочника на этот лист, а потом еще и обратится к нему?
Когда я ем,я глух и нем, хитер и быстр, и дьявольски умен.
 
Ничёнепонимаю. Нафига все эти замены? :)
Задача чисто под ВПР.
Вариант с макросом - записать рекордером вставку ВПР с нужными параметрами в нужный диапазон, нажимать кнопку и радоваться. Весь макрос - 2 строчки.
Вариант без макроса - скопировать готовую формулу в блокнот и вставлять оттуда сразу в нужный диапазон.
Код
Sub Макрос1()
   With Range(Cells(3, 2), Cells(Rows.Count, 2).End(xlUp)).Offset(, 1)
    .FormulaR1C1 = "=VLOOKUP(RC[-1],R3C9:R9C10,2,0)"
    .Value = .Value
    End With
End Sub
 
Цитата
MonsterBeer написал:
Макрос реализован в надстройке, а как мне закинуть данные справочника на этот лист, а потом еще и обратится к нему?
Создайте файл xlsx например (СправочникЗамен.xlsx), внесите в него список замен, сохраните его в формате хlam, добавьте надстройку, затем как в коде ниже.

Код
Sub test()
    Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
    Dim cl As Range
    Dic.CompareMode = vbTextCompare
    With Workbooks("СправочникЗамен.xlam").Sheets("Лист1")
        For Each cl In .[A1:A8]
            Dic.Add cl.Value, cl.Offset(, 1).Value
        Next cl
    End With
    For Each cl In Selection
        If Dic.exists(cl.Value) Then cl.Value = Dic(cl.Value)
    Next cl
    Set Dic = Nothing
End Sub

Изменено: Scripter - 21.05.2015 04:53:19
 
Scripter,
Шикарно!
2500 строчек обработал за 2 секунды!
RAN,
Не подходит.. нужно  было загнать справочник  и из него брать данные.

И последнее
как в этой строчке указать что нужно смотреть первые 3 знака?
(В некоторых отчетах данные формата ANY - без группы)
Код
If Dic.exists(cl.Value) Then

Сделал, но ругается...
Изменено: MonsterBeer - 21.05.2015 11:48:10
Когда я ем,я глух и нем, хитер и быстр, и дьявольски умен.
 
Цитата
Scripter написал:
Dic.Add "DAX", "ФИО1"
Добрый день!
Подскажите, а возможно сделать замену но с учетом регистра?
Когда я ем,я глух и нем, хитер и быстр, и дьявольски умен.
Страницы: 1
Наверх