Доделать макрос поиска слов в фразах

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Доделать макрос поиска слов в фразах (Макросы/Sub)

lybashevv

Дата: Понедельник, 28.11.2016, 13:47 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 1

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Здравствуйте помогите пожалуйста доделать макрос.
У меня есть макрос, который делает то что мне нужно, но не до конца.

Основной смысл, для чего мне макрос:
- есть 1 колонка со словами
- есть 2 колонка с фразами
- нужно найти фразы из 2 колонки в которых есть слова из 1 колонки
- и расположить фразы в которых содержится слово, напротив этого слова, таким образом как показано в примере

То что нужно доделать:
- слово и фраза, в которой оно найдено, были напротив друг друга,
- а напротив остальных фраз, в которых найдено слово(если фраза не одна), в 1 колонке была бы пустая ячейка
- и напротив слова из 1 столбца, которое не содержится ни в одной фразе из 2, была пустая ячейка в колонке 2

Код макроса:
[vba]

Код

Sub FindWords()
Dim fl As Boolean
Dim arrTemp2()
Dim arrTemp1()
    arrW = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row).Value
    arrPh = Range("D2 <img rel="usm" src="/sml2/biggrin.gif" border="0" align="absmiddle" alt=" <img rel="usm" src="/sml2/biggrin.gif" border="0" align="absmiddle" alt=":D" /> " /> " & Cells(Rows.Count, "D").End(xlUp).Row).Value
    For I = 1 To UBound(arrPh)
        fl = False
        For J = 1 To UBound(arrW)
            If arrPh(I, 1) Like "*" & arrW(J, 1) & "*" Then
                ReDim Preserve arrTemp1(I)
                arrTemp1(I) = arrPh(I, 1)
                fl = True
                Exit For
            End If
        Next
        If Not fl Then
            N = N + 1
            ReDim Preserve arrTemp2(N)
            arrTemp2(N) = arrPh(I, 1)
        End If
    Next
    Columns("D").ClearContents
    Range("D1").Resize(UBound(arrTemp1) + 1) = Application.Transpose(arrTemp1)
    Columns("F").ClearContents
    Range("F1").Resize(UBound(arrTemp2) + 1) = Application.Transpose(arrTemp2)
End Sub

[/vba]

Код

[/vba]lybashevv

К сообщению приложен файл: -___.xlsm (17.1 Kb)

Сообщение отредактировал lybashevv - Понедельник, 28.11.2016, 15:26

Ответить

СообщениеЗдравствуйте помогите пожалуйста доделать макрос.
У меня есть макрос, который делает то что мне нужно, но не до конца.

Основной смысл, для чего мне макрос:
- есть 1 колонка со словами
- есть 2 колонка с фразами
- нужно найти фразы из 2 колонки в которых есть слова из 1 колонки
- и расположить фразы в которых содержится слово, напротив этого слова, таким образом как показано в примере

То что нужно доделать:
- слово и фраза, в которой оно найдено, были напротив друг друга,
- а напротив остальных фраз, в которых найдено слово(если фраза не одна), в 1 колонке была бы пустая ячейка
- и напротив слова из 1 столбца, которое не содержится ни в одной фразе из 2, была пустая ячейка в колонке 2

Код макроса:
[vba]

Код

[/vba]

Автор - lybashevv
Дата добавления - 28.11.2016 в 13:47

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Доделать макрос поиска слов в фразах (Макросы/Sub)

Страница 1 из 1
1