Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 11.09.2013, 10:57   #1
strannick
Форумчанин
 
Регистрация: 21.10.2011
Сообщений: 433
По умолчанию Сравнение и удаление части текстовых строк

Добрый день, уважаемые форумчане!
Есть названия товаров и слова и словосочетания, которые нужно удалить из названий товаров если названия завершаются этими словами или словосочетаниями. Как правило, это годы, цвета, индексы всякие. Но дело не в этом.
Вот такая конструкция сравнивает названия товаров с этими словами и словосочетаниями, если находит, то удаляет из названия и результат выводит в соседний столбец и помечает ячейку:

Код:
Set sh = Sheets("Без_слов")
Set sh3 = Sheets("Слова")

iLastRow = sh.Cells(Rows.Count, 1).End(xlUp).Row
iLastRow2 = sh3.Cells(Rows.Count, 1).End(xlUp).Row

sh.Range("A1:A" & iLastRow).Copy
sh.Range("B1").PasteSpecial Paste:=xlPasteValues

kolvo1 = 0
Set IRange1 = sh.Range("B1:B" & iLastRow)
Set IRange2 = sh3.Range("A1:A" & iLastRow2)
    For Each rCell1 In IRange1
    For Each rCell2 In IRange2

        If rCell1 <> "" Then
            shablon = "*" & " " & rCell2
            If rCell1 Like shablon Then
                rCell1.Offset(, 1).Interior.ColorIndex = 22
                rCell1.Offset(, 1) = Replace(rCell1, rCell2, "")
                kolvo1 = kolvo1 + 1
            End If
        End If
Next
Next

MsgBox "Найдено и удалено " & kolvo1 & " совпадений"
Работает, вроде все нормально. Но на небольших объемах. Если количество названий товаров тысяч под 100 да еще и слов тысяч 100, то тормоз конкретный. Умом понимаю, что такие объемы надо обрабатывать в словарях, но как это реализовать - не соображу. Подскажите конструкцию.
Заранее благодарен!
Вложения
Тип файла: rar удаление.rar (178.3 Кб, 1 просмотров)
strannick вне форума Ответить с цитированием
Старый 11.09.2013, 11:06   #2
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

Цитата:
Умом понимаю, что такие объемы надо обрабатывать в словарях...
Если подсвечивать, то словари не помогут, т. к. все равно придется работать со свойствами ячеек. Может быть Вас устроит вывод отобранных значений в соседний столбец без подсвечивания? Тогда скорость обработки можно увеличить в десятки (сотни) раз.
Чем шире угол зрения, тем он тупее.
SAS888 вне форума Ответить с цитированием
Старый 11.09.2013, 11:17   #3
strannick
Форумчанин
 
Регистрация: 21.10.2011
Сообщений: 433
По умолчанию

Да в принципе можно и без подсветки, это уже вторично. Если уж надо будет подсветить, то можно и результаты потом сравнить и ....
strannick вне форума Ответить с цитированием
Старый 11.09.2013, 14:04   #4
staniiislav
Форумчанин
 
Аватар для staniiislav
 
Регистрация: 16.04.2010
Сообщений: 695
По умолчанию

попробуйте так:

Код:
    Dim arr, rng As Range, rng2 As Range, lsRow&, i&, s$
    lsRow = Cells(Rows.Count, 1).End(xlUp).Row
    arr = Range("A1:A" & lsRow).Value
    [B1].Resize(UBound(arr), 1) = arr
    Set rng = Range("B1:B" & lsRow)
    lsRow = Sheets("Слова").Cells(Rows.Count, 1).End(xlUp).Row
    arr = Sheets("Слова").Range("A1:A" & lsRow).Value
        For i = 1 To UBound(arr)
            If arr(i, 1) > 0 Then
                s = "*" & arr(i, 1)
                Set rng2 = rng.Find(What:=s, LookIn:=xlValues, LookAt:=xlWhole)
                If Not rng2 Is Nothing Then
                    Cells(rng2.Row, 3) = Replace(Cells(rng2.Row, 1), arr(i, 1), "")
                    Cells(rng2.Row, 3).Interior.ColorIndex = 22
                End If
            End If
        Next i
Единственный способ стать умнее, играть с более умным противником...
staniiislav вне форума Ответить с цитированием
Старый 11.09.2013, 14:19   #5
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

Можно всю проверку/циклы делать на массивах, а подсвечивать уже на листе.
Может там подсветить всего сотню строк нужно? Вот как их потом искать будете?
А словарь тут не помощник - он годится когда ищется точное совпадение, в случае с Like словарь отдыхает...
webmoney: E265281470651 Z422237915069 R418926282008
Hugo121 вне форума Ответить с цитированием
Старый 18.10.2013, 19:36   #6
strannick
Форумчанин
 
Регистрация: 21.10.2011
Сообщений: 433
По умолчанию

Возвращаясь к теме:
Цитата:
Сообщение от staniiislav Посмотреть сообщение
попробуйте так:
такая конструкция работает конечно быстрее, но находит и убирает она только первое найденное в массиве. Если же будет несколько ячеек с одинаковым окончанием

Код:
s = "*" & arr(i, 1)
то начиная со второй все остается неизменным.
Или я не прав?
strannick вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сравнение текстовых(строковых) (строк,ячеек)массивов - с одинаковыми данными но по разному написанными! redyps Microsoft Office Excel 1 28.07.2013 15:58
Сравнение текстовых значений climber Microsoft Office Excel 2 24.01.2013 17:09
Сравнение строк двух текстовых файлов Alina111 Общие вопросы C/C++ 4 10.01.2013 10:03
Удаление части строк в memo igabenu Помощь студентам 3 17.10.2012 17:47
Сравнение дат и удаление невыделенных строк alegu Microsoft Office Excel 9 16.04.2010 22:15