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

для примера
в столбец А из другого источника вставляется уникальный номер, проблема в том, что там он двух видов
1 некорректный - 4501064193
2 корректный - 4501064193/000010/1

Мне нужно, что бы при вставке в столбец всех номеров к первому варианту автоматически добавлялся текст "/000010/1", а второй оставался без изменений
так как длина номера всегда 10ти значная, решил проблему с помощью простой формулы

=ЕСЛИ(ДЛСТР(A1)=10;A1&"/000010/1";A1)

то есть когда ячейка содержит 10 символов к ней добавляется недостающий текст, если не содержит, тогда возвращает ячейку

В общем хочется реализовать эту формулу с помощью макроса, что бы при вставке массива, например штук 500 в столбец А, макрос автоматически добавлял недостающие символы к первому варианту
чем не подходит формула, она требует добавления столбца и постоянного "протягивания" формулы по всем добавленным ячейкам, файл большой с множеством формул, форматирований и десятками тысяч строк, плюс используется другими сотрудниками в различных целях, отчетах и сводных таблицах, добавление колонки все рушит, у кого-то не срабатывают формулы привязанные к файлу, то еще что-то, по этому макрос жизненно необходим))
ну и насколько я знаю, использовать формулу в этой же ячейке где и исходные данные не возможно, а это самое главное, т.к. файл обновляемый и все привыкли просто заменять его, чем сохранять под новым именем, открывать и копировать исходные данные чтобы не сбить столбец с формулой, всем не угодишь, а мне уже надоело ее каждый день добавлять и протягивать, пытался с помощью записи макроса, но ничего не вышло, поэтому прошу вашей помощи господа!))
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Application.EnableEvents = False
        For Each c In Target
            If Len(c) = 10 Then c.Value = c & "/000010/1"
        Next
        Application.EnableEvents = True
    End If
End Sub
Изменено: buchlotnik - 14.07.2020 20:42:47
Соблюдение правил форума не освобождает от модераторского произвола
 
Цитата
buchlotnik написал:
For Each c In Target
Михаил, ну как так? ну вставил я в A2:c2 всяку дичь, в B2,С2  еще страшнее стало.
А если удалил, то и вовсе прикольно вышло.
Изменено: БМВ - 14.07.2020 20:48:13
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал:
вставил я в A2:c2 всяку дичь
Цитата
CAN1 написал:
вставке массива, например штук 500 в столбец А
еще докопы будут?
Соблюдение правил форума не освобождает от модераторского произвола
 
Цитата
buchlotnik написал:
еще докопы будут?
Аватарку верни :-)
По вопросам из тем форума, личку не читаю.
 
офф
это не я... мля, товарисчи, лабу сперли, вместе с библиотекой!всё, вернул, что это было?
Изменено: buchlotnik - 14.07.2020 21:07:24
Соблюдение правил форума не освобождает от модераторского произвола
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Application.EnableEvents = False
        For Each c In Intersect(Target, Range("A:A")).SpecialCells(xlCellTypeConstants)
            If Len(c) = 10 Then c.Value = c & "/000010/1"
        Next
        Application.EnableEvents = True
    End If
End Sub
По вопросам из тем форума, личку не читаю.
 
Спасибо за решение! Подскажите, как его правильно внедрить в мой файлик, не получается у меня, вставил модуль на лист который нужен, вставил код в модуль, изменил столбец А:А на I:I но ничего не выходит

книга называется: Реестр тех заказов ММКИ
лист: Реестр

Буду очень благодарен, с вба не дружу не могу понять, что к чему привязано
 
CAN1, а покажите скрин куда встали макрос в модуль листа нужно  
Не бойтесь совершенства. Вам его не достичь.
 
на Лист1 правой мышкой, инсерт - модуль и в него вставил код, пробовал менять worksheet_change на свое название, но тоже не получается(
 
CAN1, не верно в модуль листа это нажать на лист два раза и вставить, т.е. не нужно создавать модуль.
ЧТО ЖЕ ТАКОЕ МОДУЛЬ?
Изменено: Mershik - 14.07.2020 22:15:08
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, оо теперь заработало, спасибо всем огромное!

кстати код от пользователя БМВ выбивает ошибку, а первый работает как нужно, сейчас вставил штук 200, где не хватало, все добавилось в автомате, еще раз спасибо за помощь :)
 
Цитата
CAN1 написал:
кстати код от пользователя БМВ выбивает ошибку,
прям таки обидно сразу стало
Код
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Application.EnableEvents = False
        For Each c In Intersect(Target, Range("A:A")).SpecialCells(xlCellTypeConstants)
            If Len(c) = 10 Then c.Value = c & "/000010/1"
        Next
        Application.EnableEvents = True
    End If
End Sub

Скорее всего при удалении или .... добавили On Error Resume Next и все.
По вопросам из тем форума, личку не читаю.
Страницы: 1
Наверх