Страницы: 1 2 След.
RSS
После вставки текста с цифрами/символами в ячейке оставить только цифры
 
Как сделать, чтоб после вставки номера типа "+7 (00822) 123-45-67" через ctrl+v в ячейку оствалось "7008221234567" с автоматическим удалением всех нецифровых символов?
В интернете смотрел, на форумах смотрел, на данный момент пользуюсь 2-мя дополнительными ячейками, в одну из которых вставляю номер, а во второй высвечиваются только цифры, которые потом копирую в нужную ячейку. Удобно, но только при небольших кол-вах.
Подскажите, можно ли реализовать эту "очистку" сразу во время вставки из буфера? Особенность: некоторые номера начинаются с цифры 0, нужно чтоб в таком случае "0" также оставался (а не исчезал, как при числовом форматировании текста).
Буду признателен за ответы, наводки, подсказки.
 
Ищите по слову Replace_symbols или ExtractNumber
Я сам - дурнее всякого примера! ...
 
kuklp,
все что нашел - про формулы, которые работают на основе входных данных из других ячеек. Такое не подходит. Есть идеи про преобразование внутри буфера обмена?
 
UDF
Код
Public Function iPhone(istring As Range) As String
 Dim re As Object
 Set re = CreateObject("vbscript.regexp")
    re.Pattern = "(-|\s|\+|\(|\))"
    re.Global = True
    re.IgnoreCase = True
    iPhone = re.Replace(istring, "")
End Function
 
Цитата
msdoser написал:
Есть идеи про преобразование внутри буфера обмена
никто такими глупостями не занимается. Используйте то что нашли по событию листа change и будет Вам счастье.
Я сам - дурнее всякого примера! ...
 
Взял совет от Серёжки, макрос от Володьки:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 1 Then Exit Sub
Columns(1).NumberFormat = "@"
With CreateObject("vbscript.regexp")
    .Pattern = "(-|\+|\ |\(|\))"
    .Global = True
    .IgnoreCase = True
    ActiveCell = .Replace(ActiveCell, "")
End With
End Sub
-----------
Забыл сказать. Изменения в первом столбце приводят к активации макроса. Макрос помещается в модуль листа.
Изменено: Владимир - 08.09.2017 11:16:44
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
Кнопка цитирования не для ответа [МОДЕРАТОР]

а как им пользоваться?) пытаюсь прописать функцию Worksheet_changae() но оно не работает
 
Код
Function NumbersOnly$(s$)
  Dim i&, ch$
  For i = 1 To Len(s)
    ch = Mid(s, i, 1): If ch >= "0" And ch <= "9" Then NumbersOnly = NumbersOnly & ch
  Next
End Function
Изменено: Ігор Гончаренко - 08.09.2017 12:30:58
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
msdoser,
Цитата
Владимир написал:
Макрос помещается в модуль листа.
Изменено: Jack Famous - 08.09.2017 11:59:34
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Для первого столбца.
Я сам - дурнее всякого примера! ...
 
Цитата
msdoser написал:
"+7 (00822) 123-45-67" через ctrl+v
Вот берите и копируйте и вставляйте в столбец F:M.
Изменено: Владимир - 08.09.2017 12:54:02 (..Клещами ведь нужно вытягивать.)
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
kuklp,
Уважаемый, подскажите, а где в коде нужно менять, чтоб можно было использовать эту прелесть в другом столбике(-ах) (у меня несколько столбиков с номерами в БД, в диапазоне F:M)?
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    If Intersect(Target, [f:m]) Is nothing Then Exit Sub
    Application.EnableEvents = False
    For Each c In Target.Cells
        c = "'" & ExtractNumber(c.Value)
    Next
    Application.EnableEvents = True
End Sub
Изменено: kuklp - 08.09.2017 12:42:02
Я сам - дурнее всякого примера! ...
 
Можно ли 1ю ячейку столбика от этого правила? там просто название столбика и оно стирается.
 
kuklp,
Спасибо Вам. Очень помогли. можно ли первую строчку таблицы исключить из правила? там заголовки столбиков
 
Код
If Intersect(Target, [f:m]) Is nothing Then Exit Sub
If Target.row=1 Then Exit Sub
...
Я сам - дурнее всякого примера! ...
 
msdoser, функции избавят вас от подобных проблем — вам предложили уже несколько вариантов
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Jack Famous, это Вы к чему написали? В чем смысл Вашей сентенции?
Я сам - дурнее всякого примера! ...
 
kuklp,
теперь при вставке номера в столбцы диапазона "F:M" выдает ошибку с отсылкой на код в странице. Скрины в прикрепленных
 
А саму функцию ExtractNumber Вы скопировали в свою книгу? В общий модуль.
Я сам - дурнее всякого примера! ...
 
Я почему не стал объединять событийную процедуру с функцией, как у Володи - возможно в дальнейшем Вы войдете во вкус и захотите например сделать форму ввода номеров, добавить листы с номерами и т.д. Там тоже можно будет использовать эту же функцию не изменяя ее.
Я сам - дурнее всякого примера! ...
 
Может проще надо
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
  If Not Intersect(Target, Columns("F:M")) Is Nothing Then
    With CreateObject("vbscript.regexp")
      .Pattern = "(-|\+|\ |\(|\""|\))"
      .Global = True
      .IgnoreCase = True
      Target = "'" & .Replace(Target, "")
    End With
  End If
End Sub
 
Володь, а в чем простота? В использовании сторонней регексп? К тому же жутко тормозной :) И еще, в твоем варианте можно только по одной ячейке вставлять. Если вздумается вставить диапазон из номеров, он ничего не сделает. И это натолкнуло меня на мысль. :)  Так можно вставлять столбцы целиком:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    If Intersect(Target, [f:m]) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    For Each c In Target.Cells
        If c.Row <> 1 Then c = "'" & ExtractNumber(c.Value)
    Next
    Application.EnableEvents = True
End Sub
Изменено: kuklp - 08.09.2017 13:40:23
Я сам - дурнее всякого примера! ...
 
Пробую устаканить код в моей БД. Дайте чуть времени.
 
kuklp,
Сергей , я в твоем примере не нашел функции ExtractNumber
 
Цитата
Kuzmich написал:
не нашел функции
Даже не знаю, что и ответить. Вот скачал свой пример из №13, открыл ВБЕ..  :D
Я сам - дурнее всякого примера! ...
 
На всякий случай - обновленный пример со всеми правками предложенными выше.
Я сам - дурнее всякого примера! ...
 
Цитата
Даже не знаю, что и ответить.
kuklp
,
Сергей, у меня же 2003 Excel и конвертер проглотил Module1
В примере из сообщения #29 все нормально
Изменено: Kuzmich - 08.09.2017 15:03:53
 
Володь, ты о чем? Какой конвертер? Файл xls. Номер поста изменился после чистки модератора.
Изменено: kuklp - 08.09.2017 15:07:21
Я сам - дурнее всякого примера! ...
 
kuklp, спасибо, то что надо

Благодарю форум, администрацию и всех отвечающих за Ваши старания. Вы как всегда лучшие.
Изменено: msdoser - 09.09.2017 10:58:44
Страницы: 1 2 След.
Наверх