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

Вход

Регистрация

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

 

= Мир MS Excel/Замена части значения ячейки значением другой ячейки - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Замена части значения ячейки значением другой ячейки (Макросы/Sub)
Замена части значения ячейки значением другой ячейки
gugyk Дата: Четверг, 16.02.2017, 15:31 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Здравствуйте!

Необходимо создать макрос для решения следующего условия:
Имеются два столбца с данными. Необходимо в столбце B для каждой заполненной ячейке найти искомое значение, например <АБВ> (искомое значение для всех одинаковое) и заменить это вхождение на значение ячейки столбца A той же строки.
Например
A1=ГДЕ
B1= текст<АБВ>текст
после выполнения макроса значение ячейки
B1=текстГДЕтекст
 
Ответить
СообщениеЗдравствуйте!

Необходимо создать макрос для решения следующего условия:
Имеются два столбца с данными. Необходимо в столбце B для каждой заполненной ячейке найти искомое значение, например <АБВ> (искомое значение для всех одинаковое) и заменить это вхождение на значение ячейки столбца A той же строки.
Например
A1=ГДЕ
B1= текст<АБВ>текст
после выполнения макроса значение ячейки
B1=текстГДЕтекст

Автор - gugyk
Дата добавления - 16.02.2017 в 15:31
K-SerJC Дата: Четверг, 16.02.2017, 16:04 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 190
Репутация: 29 ±
Замечаний: 40% ±

Excel 2013
например так:
[vba]
Код

Sub replaceValue(Ftext As String)
Dim wb, sh, lr, f, nt, str, n
wb = ThisWorkbook.Name
sh = ActiveSheet.Name
lr = Workbooks(wb).Sheets(sh).Cells(Rows.Count, 2).End(xlUp).Row
nt = Len(Ftext)
For f = 1 To lr
str = Workbooks(wb).Sheets(sh).Cells(f, 2).Value
kn = Len(str)
For n = 1 To kn Step nt
If Mid(str, n, nt) = Ftext Then
str = Left(str, n) & Workbooks(wb).Sheets(sh).Cells(f, 1) & Mid(str, n + nt, kn - n - nt)
End If
Next n
Workbooks(wb).Sheets(sh).Cells(f, 2).Value = str
Next f
End Sub
[/vba]


Благими намерениями выстелена дорога в АД.
 
Ответить
Сообщениенапример так:
[vba]
Код

Sub replaceValue(Ftext As String)
Dim wb, sh, lr, f, nt, str, n
wb = ThisWorkbook.Name
sh = ActiveSheet.Name
lr = Workbooks(wb).Sheets(sh).Cells(Rows.Count, 2).End(xlUp).Row
nt = Len(Ftext)
For f = 1 To lr
str = Workbooks(wb).Sheets(sh).Cells(f, 2).Value
kn = Len(str)
For n = 1 To kn Step nt
If Mid(str, n, nt) = Ftext Then
str = Left(str, n) & Workbooks(wb).Sheets(sh).Cells(f, 1) & Mid(str, n + nt, kn - n - nt)
End If
Next n
Workbooks(wb).Sheets(sh).Cells(f, 2).Value = str
Next f
End Sub
[/vba]

Автор - K-SerJC
Дата добавления - 16.02.2017 в 16:04
gugyk Дата: Пятница, 17.02.2017, 12:15 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Sub replaceValue(Ftext As String)
Dim wb, sh, lr, f, nt, str, n
wb = ThisWorkbook.Name
sh = ActiveSheet.Name
lr = Workbooks(wb).Sheets(sh).Cells(Rows.Count, 2).End(xlUp).Row
nt = Len(Ftext)
For f = 1 To lr
str = Workbooks(wb).Sheets(sh).Cells(f, 2).Value
kn = Len(str)
For n = 1 To kn Step nt
If Mid(str, n, nt) = Ftext Then
str = Left(str, n) & Workbooks(wb).Sheets(sh).Cells(f, 1) & Mid(str, n + nt, kn - n - nt)
End If
Next n
Workbooks(wb).Sheets(sh).Cells(f, 2).Value = str
Next f
End Sub

Спасибо, немного подправил убрал шаг в цикле, все корректно заработало
 
Ответить
Сообщение
Sub replaceValue(Ftext As String)
Dim wb, sh, lr, f, nt, str, n
wb = ThisWorkbook.Name
sh = ActiveSheet.Name
lr = Workbooks(wb).Sheets(sh).Cells(Rows.Count, 2).End(xlUp).Row
nt = Len(Ftext)
For f = 1 To lr
str = Workbooks(wb).Sheets(sh).Cells(f, 2).Value
kn = Len(str)
For n = 1 To kn Step nt
If Mid(str, n, nt) = Ftext Then
str = Left(str, n) & Workbooks(wb).Sheets(sh).Cells(f, 1) & Mid(str, n + nt, kn - n - nt)
End If
Next n
Workbooks(wb).Sheets(sh).Cells(f, 2).Value = str
Next f
End Sub

Спасибо, немного подправил убрал шаг в цикле, все корректно заработало

Автор - gugyk
Дата добавления - 17.02.2017 в 12:15
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Замена части значения ячейки значением другой ячейки (Макросы/Sub)
Страница 1 из 11
Поиск:

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