Доброго времени суток Форумчане. Надо в журнале регистрации заполнять номер телефона звонившего. Номера будут мобильные (11 цифр) и местные (5 цифр). Вводиться номера будут вручную. Сделал через формат ячейки: [vba]
Код
[<=9999999]#-##-##;+7(###) ###-##-##
[/vba] Можно ли доработать формат ячейки что бы при случайном вводе вместо 9651234567 введут +79651234567 или 89651234567 вывод номера в ячейке был всегда +7(965) 123-45-67 Если это невозможно реализовать через формат ячейки, то может есть решение макросом?
Доброго времени суток Форумчане. Надо в журнале регистрации заполнять номер телефона звонившего. Номера будут мобильные (11 цифр) и местные (5 цифр). Вводиться номера будут вручную. Сделал через формат ячейки: [vba]
Код
[<=9999999]#-##-##;+7(###) ###-##-##
[/vba] Можно ли доработать формат ячейки что бы при случайном вводе вместо 9651234567 введут +79651234567 или 89651234567 вывод номера в ячейке был всегда +7(965) 123-45-67 Если это невозможно реализовать через формат ячейки, то может есть решение макросом?DrMini
Спасибо конечно за совет но задача не предупреждать, а исправлять. Думаю формат ячейки тут бессилен. [p.s.]может создать эту же тему в "Вопросы по VBA" ?[/p.s.]
Спасибо конечно за совет но задача не предупреждать, а исправлять. Думаю формат ячейки тут бессилен. [p.s.]может создать эту же тему в "Вопросы по VBA" ?[/p.s.]DrMini
ну вроде все очень просто при вводе значение поменять на правые 10, а далее формат уже сделает. [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Columns(1)) Is Nothing Then Application.EnableEvents = False For Each Mycell In Intersect(Target, Columns(1)) If Mycell <> "" Then Mycell.Value = CDbl(Right(Mycell, 10)) End If Next Application.EnableEvents = True End If End Sub
[/vba]
Но надо конкретно проверять что только цифры или очищать от скобок тире и пробелов, если вдруг не целое число попало ….. Короче комплексный подход нужен или через проверку данных контролировать корректность ввода, а кодом только до 10 символов значащих оставлять, что и сделано выше.
ну вроде все очень просто при вводе значение поменять на правые 10, а далее формат уже сделает. [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Columns(1)) Is Nothing Then Application.EnableEvents = False For Each Mycell In Intersect(Target, Columns(1)) If Mycell <> "" Then Mycell.Value = CDbl(Right(Mycell, 10)) End If Next Application.EnableEvents = True End If End Sub
[/vba]
Но надо конкретно проверять что только цифры или очищать от скобок тире и пробелов, если вдруг не целое число попало ….. Короче комплексный подход нужен или через проверку данных контролировать корректность ввода, а кодом только до 10 символов значащих оставлять, что и сделано выше.bmv98rus
Замечательный Временно просто медведь , процентов на 20.
Сообщение отредактировал bmv98rus - Среда, 24.04.2019, 11:05
Private Sub Worksheet_Change(ByVal Target As Range) Dim d0_ As Range Set d_ = Intersect(Target, Columns(1)) If Not d_ Is Nothing Then On Error Resume Next With d_ Application.ScreenUpdating = 0 For Each d0_ In d_ Application.EnableEvents = 0 d0_ = --Right(d0_, 10) d0_.NumberFormat = "[<=9999999]#-##-##;+7(###) ###-##-##" Application.EnableEvents = 1 Next d0_ Application.ScreenUpdating = 1 End With End If End Sub
[/vba]
*Чуть поправил
Так попробуйте [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim d0_ As Range Set d_ = Intersect(Target, Columns(1)) If Not d_ Is Nothing Then On Error Resume Next With d_ Application.ScreenUpdating = 0 For Each d0_ In d_ Application.EnableEvents = 0 d0_ = --Right(d0_, 10) d0_.NumberFormat = "[<=9999999]#-##-##;+7(###) ###-##-##" Application.EnableEvents = 1 Next d0_ Application.ScreenUpdating = 1 End With End If End Sub
Александр. Всё работает. Спасибо. Подскажите пожалуйста что надо изменить, что бы макрос работал в другом столбце. А лучше в интервале ( с 5-ой строки и ниже).
Александр. Всё работает. Спасибо. Подскажите пожалуйста что надо изменить, что бы макрос работал в другом столбце. А лучше в интервале ( с 5-ой строки и ниже).DrMini
Private Sub Worksheet_Change(ByVal Target As Range) Dim d0_ As Range Set d_ = Intersect(Target, Range("A5:D55"))'диапазон If Not d_ Is Nothing Then Application.ScreenUpdating = 0 Application.EnableEvents = 0 On Error Resume Next With d_ For Each d0_ In d_ d0_ = --Right(d0_, 10) d0_.NumberFormat = "[<=9999999]#-##-##;+7(###) ###-##-##" Next d0_ End With Application.EnableEvents = 1 Application.ScreenUpdating = 1 End If End Sub
Private Sub Worksheet_Change(ByVal Target As Range) Dim d0_ As Range Set d_ = Intersect(Target, Range("A5:D55"))'диапазон If Not d_ Is Nothing Then Application.ScreenUpdating = 0 Application.EnableEvents = 0 On Error Resume Next With d_ For Each d0_ In d_ d0_ = --Right(d0_, 10) d0_.NumberFormat = "[<=9999999]#-##-##;+7(###) ###-##-##" Next d0_ End With Application.EnableEvents = 1 Application.ScreenUpdating = 1 End If End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
