Профессиональные приемы работы в Microsoft Excel

Обмен опытом => Microsoft Excel => Тема начата: Александр Кучинский от 07.12.2017, 15:44

Название: Поиск словосочетаний по словарю и замена найденных в ячейке
Отправлено: Александр Кучинский от 07.12.2017, 15:44
Добрый день. Необходимо решить вопрос с поиском и заменой подстрок.
Дано:

На листе 1 в столбце А перечислены словосочетания таким образом:
сс1 | cc2 | cc3 | cc4
сс2 | cc6 | cc3 | cc8
сс5 | cc6 | cc7 | cc4 | cc9 | cc10
cc12 | cc13

На листе 2 в двух столбцах содержится словарь замен:
столбец А  ; столбец В
сс1 ;  новый сс1
сс2 ;  новый сс2
сс3 ; 
сс4 ;  новый сс4
сс5 ;  новый сс5
сс6 ; 
сс7 ;  новый сс7
сс8 ;  новый сс8
сс9 ; 
сс10 ;  новый сс10
сс11 ;  новый сс11
сс12 ;  новый сс12
сс13 ;  новый сс13

Нужно поменять встречающуюся подстроку в Лист1:СтолбецА, новым соответствующим значением из Лист2:СтолбецВ

Для указанного примера это будет так:
новый сс1 | новый cc2 | | новый cc4
новый сс2 | | | новый  cc8
новый сс5 | | новый cc7 | новый cc4 | | новый cc10
новый cc12 | новый cc13
Название: Re: Поиск словосочетаний по словарю и замена найденных в ячейке
Отправлено: Александр Кучинский от 07.12.2017, 16:06
Сделал пример. Во вложении. Результат на Листе 3. Также удалил лишние ||| . Если это проблема сделать сразу, то потом автозаменой смогу это сам убрать.
Название: Re: Поиск словосочетаний по словарю и замена найденных в ячейке
Отправлено: Hugo121 от 07.12.2017, 22:25
Добрый день.
Но примеры нужно составлять корректные - там практически нет совпадений, причём лишние пробелы я в коде убиваю тысячей тримов...
В общем код работает корректно на корректных данных (и на Windows)- найти проблему в данных это домашнее задание!
И надо же так данные подбирать... :)

Option Explicit

Sub tt()
    Dim a, i&, b, el

    With CreateObject("Scripting.Dictionary")
        a = Sheets(2).[a1].CurrentRegion.Value
        For i = 1 To UBound(a): .Item(Trim(a(i, 1))) = Trim(a(i, 2)): Next
        a = Sheets(1).[a1].CurrentRegion.Value
        For i = 1 To UBound(a)
            b = Split(a(i, 1), "|"): a(i, 1) = Empty
            For Each el In b
                If Len(.Item(Trim(el))) Then a(i, 1) = a(i, 1) & " | " & .Item(Trim(el))
            Next
            a(i, 1) = Mid(a(i, 1), 4)
        Next
    End With
    Sheets(1).[a1].CurrentRegion.Value = a
End Sub
Название: Re: Поиск словосочетаний по словарю и замена найденных в ячейке
Отправлено: Александр Кучинский от 08.12.2017, 10:12
Не цитируйте без необходимости [МОДЕРАТОР]

Спасибо преогромное! Запустил макрос - работает. Есть маленький недостаток - если в результате получаются несколько подряд идущих пустых строк(тоесть вообще ни сс в словаре не было), то выдается всего одна. Пример из вложения вроде корректный... Неужели я перепутал английскую и русскую раскладки на букве "с" при его составлении?... Извиняюсь если что за пример. Спасибо за помощь!
Название: Re: Поиск словосочетаний по словарю и замена найденных в ячейке
Отправлено: Hugo121 от 08.12.2017, 10:21
Вы на примере из форума пробовали код запускать?
Это чья была идея использовать "cc"? :)
Ну хоть бы "aa" - они хоть на разных клавишах, а лучше кардинально "щщ" :)
По пустым не понял - можно увидеть пример исходный и как нужно? Без кода - он есть в теме, а мои админы всё равно код режут...
Название: Re: Поиск словосочетаний по словарю и замена найденных в ячейке
Отправлено: Александр Кучинский от 08.12.2017, 14:36
Ну вот так мне кажется нагляднее:

На листе 1 в столбце А перечислены словосочетания таким образом:
сс1 | cc2 | cc3 | cc4
сс2 | cc6 | cc3 | cc8 - ни одного нет в алфавите 1-я строка
сс2 | cc6 | cc3 | cc8 | сс9 - ни одного нет в алфавите 2-я строка
сс5 | cc6 | cc7 | cc4 | cc9 | cc10
cc12 | cc13

На листе 2 в двух столбцах содержится словарь замен:
столбец А  ; столбец В
сс1 ;  новый сс1
сс2 ; 
сс3 ;
сс4 ;  новый сс4
сс5 ;  новый сс5
сс6 ;
сс7 ;  новый сс7
сс8 ; 
сс9 ;
сс10 ;  новый сс10
сс11 ;  новый сс11
сс12 ;  новый сс12
сс13 ;  новый сс13

Нужно поменять встречающуюся подстроку в Лист1:СтолбецА, новым соответствующим значением из Лист2:СтолбецВ

Для указанного примера это будет так:
новый сс1 | новый cc2 | | новый cc4
!!!!  Одна строка пустая, а второй нету !!!!
новый сс5 | | новый cc7 | новый cc4 | | новый cc10
новый cc12 | новый cc13
Название: Re: Поиск словосочетаний по словарю и замена найденных в ячейке
Отправлено: Hugo121 от 08.12.2017, 14:42
По пустым понял - мой код так не сделает, переделывать много, не буду.
Убирайте их вообще вручную фильтром.
Название: Re: Поиск словосочетаний по словарю и замена найденных в ячейке
Отправлено: Александр Кучинский от 08.12.2017, 15:16
Да вы и так помогли. С этим разберусь. Спасибо большое!
Название: Re: Поиск словосочетаний по словарю и замена найденных в ячейке
Отправлено: boa от 08.12.2017, 19:54
После выполнения основного кода, можно просто удалить пустые строки

Option Explicit

Sub DeleteEmptyRow1()
'просто удалит пустые строки
With ActiveSheet
    Dim l&, i&
    l = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = l To 1 Step -1
        If Application.WorksheetFunction.CountA(.Rows(i)) = 0 Then .Rows(i).Delete
    Next
End With
End Sub

Sub DeleteEmptyRow2()
'подсчитает сколько удалил подряд пустых строк и запишет это
With ActiveSheet
    Dim l&, i&, j&
    j = 1
    l = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = l To 1 Step -1
        If Application.WorksheetFunction.CountA(.Rows(i)) = 0 Then
            If i > 1 Then   'что бы не выпасть в ошибку на 1-й строке
                If Application.WorksheetFunction.CountA(.Rows(i - 1)) = 0 Then
                    j = j + 1
                    .Rows(i).Delete
                Else
                    .Cells(i, 1).Value = "Здесь было " & j & " пустых строк"
                    j = 1
                End If
            End If
        End If
    Next
End With
End Sub
Название: Re: Поиск словосочетаний по словарю и замена найденных в ячейке
Отправлено: Hugo121 от 08.12.2017, 20:42
Так ведь хочется по одной оставлять :)
Если бы нужно было удалить все пустые - можно просто в мой код добавить ещё один пустой аналогичный массив и собирать данные в него, увеличивая индекс, если есть что собирать.
А в финале им просто затереть исходные данные.
Название: Re: Поиск словосочетаний по словарю и замена найденных в ячейке
Отправлено: boa от 08.12.2017, 22:02
Я решил не редактировать ваш макрос, поэтому написал 2 дополнительных макроса, которые можно вызывать самостоятельно.
Один чистит все, а второй(DeleteEmptyRow2) по одной строке оставляет и считает сколько удалил смежных строк ::)