Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Удаление части текста в ячейках всего столбца
 
#1
29.01.2015 14:19:58
Здравствуйте.
Надо удалить в каждой ячейки столбца С обозначения УЛ., ПР., алл. и т.д. Делаю это вот таким кодом(здесь только его часть):

Код
Sub ЗаменаТекста()
    Range("C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=3
    Selection.Replace What:=" БУЛ.", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" УЛ.", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" ПР.", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" АЛ.", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False 
... 
... 
...
 End Sub
Поскольку число обозначений растёт, а значит растёт и код из-за этого делается всё медленно.
Вопрос: а можно ли как-то это записать покороче?

Спасибо.
 
 
 
#2
29.01.2015 14:24:15
Здравствуйте.
При помощи фильтра отфильтровать что нужно и исправить на то что надо или удалить.
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок.
А в том, чтобы писать программы, работающие при любом количестве ошибок.
 
 
 
#3
29.01.2015 14:33:30
Цитата
CAHO пишет: При помощи фильтра
Адресов 1,5 млн. Получится ещё дольше чем обработка таким макросом.
 
 
 
#4
29.01.2015 14:38:05
Короче - можно, быстрее - вряд ли.
Код
Sub Мяу()
    Dim arr, i&
    arr = Array(" БУЛ.", " УЛ.", " ПР.", " АЛ.")
    With Range(Cells(2, 3), Cells(2, 3).End(xlDown))
        For i = LBound(arr) To UBound(arr)
            .Replace What:=arr(i), Replacement:="", LookAt:=xlPart, _
                     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                     ReplaceFormat:=False
        Next
    End With
End Sub
 
 
 
#5
29.01.2015 14:44:10
Побыстрее работает. Спасибо большое!
 
 
 
#6
29.01.2015 15:31:01
Не знаю уж пригодится или нет вашего примера нету потестировать не начем тока на своем файле у мну работает

Код
Function улицы_проспекты$(s$)
Static r As Object: If r Is Nothing Then Set r = CreateObject("vbscript.regexp"):
r.Global = 1:
r.IgnoreCase = True
r.Pattern = "[а-я]{2,3}\.+ "
улицы_проспекты = r.Replace(s, "")
End Function
Лень двигатель прогресса, доказано!!!
 
 
 
#7
29.01.2015 15:36:29
Цитата
Сергей пишет: r.Pattern = "[а-я]{2,3}\.+ "
Вы таким образом можете чего лишнего удалить - сам работаю с адресами и таким вот образом не стал бы делать (есть опыт), при этом регулярки намного медленнее чем простые замены.
Необходимо не только знать, но и уметь использовать это знание, ведь самые гениальные решения наиболее просты
 
 
 
#8
29.01.2015 15:40:59
amarf, а я не рунописец так эксперементирую и для меня 0,5 секунды что 1 секунда особо не различаются, эт вы рунописцы сотые секунд замеряете  :D
Лень двигатель прогресса, доказано!!!
 
 
 
#9
29.01.2015 16:47:06
RAN, А не будет ли быстрее, если все данные в массив загнать, затем в массиве поменять значения и вывести их обратно на лист? Как мне кажется, должно работать быстрее, чем перебор ячеек. Или я не прав?

Код
Sub zamena()
    Dim arr, i&, j&
    Dim ar1()
    arr = Array("БУЛ.", "УЛ.", "ПР.", "АЛ.")
    ar1() = Range("C2", ActiveSheet.Range("C2").End(xlDown)).Value
    For i = 1 To UBound(ar1)
        For j = LBound(arr) To UBound(arr)
            ar1(i, 1) = Replace(ar1(i, 1), arr(j), "")
        Next
    Next
    ActiveSheet.Range("C2").Resize(UBound(ar1), 1) = ar1
End Sub
Изменено: ASKer_mk - 29.01.2015 17:22:34
 
 
 
Страницы: 1
Наверх