Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Замена части текста в ячейке. - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Замена части текста в ячейке. (Макросы/Sub)
Замена части текста в ячейке.
Raskat Дата: Вторник, 18.12.2018, 14:01 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Доброго дня форумчанам!
Нужна помощь с написание макроса, сам не пойму как реализовать функцию.

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

Пример желаемого:
находим запись www.excelworld.ry - автоматом меняем окончание на .ru, не меняя начала (www.excelworld).

[vba]
Код

Sub color_()
a = Array("*.kom", "*.ry", "*.r", "*.u")
c = ActiveCell.Column
For r = Cells(Rows.Count, c).End(xlUp).Row To 2 Step -1
        
    For Each Word In a
        If Cells(r, c) Like Word Then
            Rows(r).Interior.ColorIndex = 6
        End If
    Next Word

Next r
End Sub
[/vba]


Сообщение отредактировал Raskat - Вторник, 18.12.2018, 14:02
 
Ответить
СообщениеДоброго дня форумчанам!
Нужна помощь с написание макроса, сам не пойму как реализовать функцию.

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

Пример желаемого:
находим запись www.excelworld.ry - автоматом меняем окончание на .ru, не меняя начала (www.excelworld).

[vba]
Код

Sub color_()
a = Array("*.kom", "*.ry", "*.r", "*.u")
c = ActiveCell.Column
For r = Cells(Rows.Count, c).End(xlUp).Row To 2 Step -1
        
    For Each Word In a
        If Cells(r, c) Like Word Then
            Rows(r).Interior.ColorIndex = 6
        End If
    Next Word

Next r
End Sub
[/vba]

Автор - Raskat
Дата добавления - 18.12.2018 в 14:01
_Boroda_ Дата: Вторник, 18.12.2018, 14:18 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15206
Репутация: 5979 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Так нужно?
[vba]
Код
Sub color_()
    ar0 = Array("*.kom", "*.ry", "*.r", "*.u")
    ar1 = Array("*.com", "*.ru", "*.ru", "*.ru")
    c_ = ActiveCell.Column
    r1_ = Cells(Rows.Count, c_).End(xlUp).Row - 1
    ar = Cells(2, c_).Resize(r1_)
    For i = 1 To r1_
        For j = 0 To UBound(ar0)
            If ar(i, 1) Like ar0(j) Then
                ar(i, 1) = Replace(ar(i, 1), ar0(j), ar1(j))
            End If
        Next j
    Next i
    Cells(2, c_).Resize(r1_) = ar
End Sub
[/vba]
Поскольку файла нет, то макрос проверять негде было. Ежели чего - самостоятельно там поправьте


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеТак нужно?
[vba]
Код
Sub color_()
    ar0 = Array("*.kom", "*.ry", "*.r", "*.u")
    ar1 = Array("*.com", "*.ru", "*.ru", "*.ru")
    c_ = ActiveCell.Column
    r1_ = Cells(Rows.Count, c_).End(xlUp).Row - 1
    ar = Cells(2, c_).Resize(r1_)
    For i = 1 To r1_
        For j = 0 To UBound(ar0)
            If ar(i, 1) Like ar0(j) Then
                ar(i, 1) = Replace(ar(i, 1), ar0(j), ar1(j))
            End If
        Next j
    Next i
    Cells(2, c_).Resize(r1_) = ar
End Sub
[/vba]
Поскольку файла нет, то макрос проверять негде было. Ежели чего - самостоятельно там поправьте

Автор - _Boroda_
Дата добавления - 18.12.2018 в 14:18
sboy Дата: Вторник, 18.12.2018, 14:34 | Сообщение № 3
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2518
Репутация: 715 ±
Замечаний: 0% ±

Excel 2010
_Boroda_, а разве в реплейсе звездочки применяются?
мой вариант
[vba]
Код
Sub color_()
a = Array("*.kom", "*.ry", "*.r", "*.u")
b = Array("com", "ru")
c = ActiveCell.Column
For r = Cells(Rows.Count, c).End(xlUp).Row To 2 Step -1
    t = Cells(r, c).Value
    For i = 0 To UBound(a)
        If t Like a(i) Then
            Select Case i
                Case 0: y = 3: x = 0
                Case 1: y = 2: x = 1
                Case Else: y = 1: x = 1
            End Select
            Cells(r, c).Value = Left(t, Len(t) - y) & b(x)
            Exit For
        End If
    Next i
Next r
End Sub
[/vba]


Яндекс: 410016850021169
 
Ответить
Сообщение_Boroda_, а разве в реплейсе звездочки применяются?
мой вариант
[vba]
Код
Sub color_()
a = Array("*.kom", "*.ry", "*.r", "*.u")
b = Array("com", "ru")
c = ActiveCell.Column
For r = Cells(Rows.Count, c).End(xlUp).Row To 2 Step -1
    t = Cells(r, c).Value
    For i = 0 To UBound(a)
        If t Like a(i) Then
            Select Case i
                Case 0: y = 3: x = 0
                Case 1: y = 2: x = 1
                Case Else: y = 1: x = 1
            End Select
            Cells(r, c).Value = Left(t, Len(t) - y) & b(x)
            Exit For
        End If
    Next i
Next r
End Sub
[/vba]

Автор - sboy
Дата добавления - 18.12.2018 в 14:34
_Boroda_ Дата: Вторник, 18.12.2018, 14:41 | Сообщение № 4
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15206
Репутация: 5979 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
_Boroda_, а разве в реплейсе звездочки применяются?

Нет конечно. Именно поэтому и написал
Поскольку файла нет, то макрос проверять негде было

Вот так тогда
[vba]
Код
Sub color_()
    ar0 = Array(".kom", ".ry", ".r", ".u")
    ar1 = Array(".com", ".ru", ".ru", ".ru")
    c_ = ActiveCell.Column
    r1_ = Cells(Rows.Count, c_).End(xlUp).Row - 1
    ar = Cells(2, c_).Resize(r1_)
    For i = 1 To r1_
        For j = 0 To UBound(ar0)
            If InStr(ar(i, 1), ar0(j)) Then
                ar(i, 1) = Replace(ar(i, 1), ar0(j), ar1(j))
            End If
        Next j
    Next i
    Cells(2, c_).Resize(r1_) = ar
End Sub
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение
_Boroda_, а разве в реплейсе звездочки применяются?

Нет конечно. Именно поэтому и написал
Поскольку файла нет, то макрос проверять негде было

Вот так тогда
[vba]
Код
Sub color_()
    ar0 = Array(".kom", ".ry", ".r", ".u")
    ar1 = Array(".com", ".ru", ".ru", ".ru")
    c_ = ActiveCell.Column
    r1_ = Cells(Rows.Count, c_).End(xlUp).Row - 1
    ar = Cells(2, c_).Resize(r1_)
    For i = 1 To r1_
        For j = 0 To UBound(ar0)
            If InStr(ar(i, 1), ar0(j)) Then
                ar(i, 1) = Replace(ar(i, 1), ar0(j), ar1(j))
            End If
        Next j
    Next i
    Cells(2, c_).Resize(r1_) = ar
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 18.12.2018 в 14:41
sboy Дата: Вторник, 18.12.2018, 14:48 | Сообщение № 5
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2518
Репутация: 715 ±
Замечаний: 0% ±

Excel 2010
Вот так тогда

не, тогда www.kommersant.ru превратится в www.commersant.ru


Яндекс: 410016850021169
 
Ответить
Сообщение
Вот так тогда

не, тогда www.kommersant.ru превратится в www.commersant.ru

Автор - sboy
Дата добавления - 18.12.2018 в 14:48
_Boroda_ Дата: Вторник, 18.12.2018, 15:21 | Сообщение № 6
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15206
Репутация: 5979 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Согласен.
Raskat, вот к чему приводит отсутствие файла-примера! Сколько времени зря потрачено!

[vba]
Код
Sub color_()
    ar0 = Array(".kom", ".ry", ".r", ".u")
    ar1 = Array(".com", ".ru", ".ru", ".ru")
    c_ = ActiveCell.Column
    r1_ = Cells(Rows.Count, c_).End(xlUp).Row - 1
    ar = Cells(2, c_).Resize(r1_)
    For i = 1 To r1_
        For j = 0 To UBound(ar0)
            dl_ = Len(ar0(j))
            If Right(ar(i, 1), dl_) = ar0(j) Then
                ar(i, 1) = Left(ar(i, 1), Len(ar(i, 1)) - dl_) & ar1(j)
            End If
        Next j
    Next i
    Cells(2, c_).Resize(r1_) = ar
End Sub
[/vba]

[vba]
Код
Sub color1_()
    ar0 = Array("*.kom", "*.ry", "*.r", "*.u")
    ar1 = Array(".com", ".ru", ".ru", ".ru")
    c_ = ActiveCell.Column
    r1_ = Cells(Rows.Count, c_).End(xlUp).Row - 1
    ar = Cells(2, c_).Resize(r1_)
    For i = 1 To r1_
        For j = 0 To UBound(ar0)
            If ar(i, 1) Like ar0(j) Then
                ar(i, 1) = Left(ar(i, 1), Len(ar(i, 1)) - Len(ar0(j) + 1) & ar1(j))
            End If
        Next j
    Next i
    Cells(2, c_).Resize(r1_) = ar
End Sub
[/vba]

* Всё, надоело


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеСогласен.
Raskat, вот к чему приводит отсутствие файла-примера! Сколько времени зря потрачено!

[vba]
Код
Sub color_()
    ar0 = Array(".kom", ".ry", ".r", ".u")
    ar1 = Array(".com", ".ru", ".ru", ".ru")
    c_ = ActiveCell.Column
    r1_ = Cells(Rows.Count, c_).End(xlUp).Row - 1
    ar = Cells(2, c_).Resize(r1_)
    For i = 1 To r1_
        For j = 0 To UBound(ar0)
            dl_ = Len(ar0(j))
            If Right(ar(i, 1), dl_) = ar0(j) Then
                ar(i, 1) = Left(ar(i, 1), Len(ar(i, 1)) - dl_) & ar1(j)
            End If
        Next j
    Next i
    Cells(2, c_).Resize(r1_) = ar
End Sub
[/vba]

[vba]
Код
Sub color1_()
    ar0 = Array("*.kom", "*.ry", "*.r", "*.u")
    ar1 = Array(".com", ".ru", ".ru", ".ru")
    c_ = ActiveCell.Column
    r1_ = Cells(Rows.Count, c_).End(xlUp).Row - 1
    ar = Cells(2, c_).Resize(r1_)
    For i = 1 To r1_
        For j = 0 To UBound(ar0)
            If ar(i, 1) Like ar0(j) Then
                ar(i, 1) = Left(ar(i, 1), Len(ar(i, 1)) - Len(ar0(j) + 1) & ar1(j))
            End If
        Next j
    Next i
    Cells(2, c_).Resize(r1_) = ar
End Sub
[/vba]

* Всё, надоело

Автор - _Boroda_
Дата добавления - 18.12.2018 в 15:21
Raskat Дата: Вторник, 18.12.2018, 16:42 | Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 9
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Raskat, вот к чему приводит отсутствие файла-примера! Сколько времени зря потрачено!

Учту на будущее.
Огромное спасибо за помощь. Чуть подкрутил под себя - и все заработало как надо.

А можно понаглеть и еще пару вопросов по коду задать? не понимаю пару мест.
Зачем после переменных нижнее подчеркивание везде выставлено?
[vba]
Код
c_ = ActiveCell.Column
[/vba]
А вот этот кусок вообще не понимаю. Почитал что это какя-то альтернатива циклу, но для чего конкретно он нужен в этом коде - не соображу.
[vba]
Код
ar = Cells(2, c_).Resize(r1_)
[/vba]
 
Ответить
Сообщение
Raskat, вот к чему приводит отсутствие файла-примера! Сколько времени зря потрачено!

Учту на будущее.
Огромное спасибо за помощь. Чуть подкрутил под себя - и все заработало как надо.

А можно понаглеть и еще пару вопросов по коду задать? не понимаю пару мест.
Зачем после переменных нижнее подчеркивание везде выставлено?
[vba]
Код
c_ = ActiveCell.Column
[/vba]
А вот этот кусок вообще не понимаю. Почитал что это какя-то альтернатива циклу, но для чего конкретно он нужен в этом коде - не соображу.
[vba]
Код
ar = Cells(2, c_).Resize(r1_)
[/vba]

Автор - Raskat
Дата добавления - 18.12.2018 в 16:42
_Boroda_ Дата: Вторник, 18.12.2018, 17:00 | Сообщение № 8
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15206
Репутация: 5979 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
1. Чтобы случайно не назвать переменную зарезервированным в VBA именем. Обычно (не всегда) это не особо страшно, но лучше не стОит
2. Одна из самых тормознутых вещей в VBA - это работа с ячейками (диапазонами) на листе. Есл иячеек не очень много, то это не сильно заметно, но чем их больше, тем все печальнее
Поэтому я обращаюсь к листу всего два раза (не считая определения последней заполненной строки) -
1) взял диапазон в массив ar,
поработал я этим массивом и
2) положил массив обратно


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение1. Чтобы случайно не назвать переменную зарезервированным в VBA именем. Обычно (не всегда) это не особо страшно, но лучше не стОит
2. Одна из самых тормознутых вещей в VBA - это работа с ячейками (диапазонами) на листе. Есл иячеек не очень много, то это не сильно заметно, но чем их больше, тем все печальнее
Поэтому я обращаюсь к листу всего два раза (не считая определения последней заполненной строки) -
1) взял диапазон в массив ar,
поработал я этим массивом и
2) положил массив обратно

Автор - _Boroda_
Дата добавления - 18.12.2018 в 17:00
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Замена части текста в ячейке. (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2019 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!