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

Вход

Регистрация

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

 

= Мир MS Excel/Номера телефонов через формат ячейки макросом - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Номера телефонов через формат ячейки макросом (Макросы/Sub)
Номера телефонов через формат ячейки макросом
DrMini Дата: Среда, 24.04.2019, 09:53 | Сообщение № 1
Группа: Проверенные
Ранг: Старожил
Сообщений: 1609
Репутация: 195 ±
Замечаний: 0% ±

Excel LTSC 2024 RUS
Доброго времени суток Форумчане.
Надо в журнале регистрации заполнять номер телефона звонившего. Номера будут мобильные (11 цифр) и местные (5 цифр).
Вводиться номера будут вручную. Сделал через формат ячейки:
[vba]
Код
[<=9999999]#-##-##;+7(###) ###-##-##
[/vba]
Можно ли доработать формат ячейки что бы при случайном вводе вместо 9651234567 введут +79651234567 или 89651234567 вывод номера в ячейке был всегда +7(965) 123-45-67
Если это невозможно реализовать через формат ячейки, то может есть решение макросом?
К сообщению приложен файл: 4014297.xlsx (9.4 Kb)


Сообщение отредактировал DrMini - Среда, 24.04.2019, 10:46
 
Ответить
СообщениеДоброго времени суток Форумчане.
Надо в журнале регистрации заполнять номер телефона звонившего. Номера будут мобильные (11 цифр) и местные (5 цифр).
Вводиться номера будут вручную. Сделал через формат ячейки:
[vba]
Код
[<=9999999]#-##-##;+7(###) ###-##-##
[/vba]
Можно ли доработать формат ячейки что бы при случайном вводе вместо 9651234567 введут +79651234567 или 89651234567 вывод номера в ячейке был всегда +7(965) 123-45-67
Если это невозможно реализовать через формат ячейки, то может есть решение макросом?

Автор - DrMini
Дата добавления - 24.04.2019 в 09:53
_Boroda_ Дата: Среда, 24.04.2019, 10:06 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Сделайте еще проверку ячейки (Данные - Проверка данных) Целое число, Меньше или равно, 9999999999
К сообщению приложен файл: 4014297_1.xlsx (9.8 Kb)


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

Автор - _Boroda_
Дата добавления - 24.04.2019 в 10:06
DrMini Дата: Среда, 24.04.2019, 10:33 | Сообщение № 3
Группа: Проверенные
Ранг: Старожил
Сообщений: 1609
Репутация: 195 ±
Замечаний: 0% ±

Excel LTSC 2024 RUS
Сделайте еще проверку ячейки

Спасибо конечно за совет но задача не предупреждать, а исправлять. Думаю формат ячейки тут бессилен.
[p.s.]может создать эту же тему в "Вопросы по VBA" ?[/p.s.]
 
Ответить
Сообщение
Сделайте еще проверку ячейки

Спасибо конечно за совет но задача не предупреждать, а исправлять. Думаю формат ячейки тут бессилен.
[p.s.]может создать эту же тему в "Вопросы по VBA" ?[/p.s.]

Автор - DrMini
Дата добавления - 24.04.2019 в 10:33
Pelena Дата: Среда, 24.04.2019, 10:39 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 19165
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
может создать эту же тему в "Вопросы по VBA" ?

не надо, она будет закрыта, как дубль. См. Правила форума.
Могу перенести в раздел VBA


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщение
может создать эту же тему в "Вопросы по VBA" ?

не надо, она будет закрыта, как дубль. См. Правила форума.
Могу перенести в раздел VBA

Автор - Pelena
Дата добавления - 24.04.2019 в 10:39
DrMini Дата: Среда, 24.04.2019, 10:41 | Сообщение № 5
Группа: Проверенные
Ранг: Старожил
Сообщений: 1609
Репутация: 195 ±
Замечаний: 0% ±

Excel LTSC 2024 RUS
Могу перенести в раздел VBA

Буду очень признателен. Спасибо.
 
Ответить
Сообщение
Могу перенести в раздел VBA

Буду очень признателен. Спасибо.

Автор - DrMini
Дата добавления - 24.04.2019 в 10:41
bmv98rus Дата: Среда, 24.04.2019, 10:53 | Сообщение № 6
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4099
Репутация: 766 ±
Замечаний: 0% ±

Excel 2013/2016
ну вроде все очень просто при вводе значение поменять на правые 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 символов значащих оставлять, что и сделано выше.


Замечательный Временно просто медведь , процентов на 20.

Сообщение отредактировал bmv98rus - Среда, 24.04.2019, 11:05
 
Ответить
Сообщениену вроде все очень просто при вводе значение поменять на правые 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
Дата добавления - 24.04.2019 в 10:53
_Boroda_ Дата: Среда, 24.04.2019, 11:03 | Сообщение № 7
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Так попробуйте
[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
[/vba]

*Чуть поправил
К сообщению приложен файл: 4014297_2.xlsm (16.0 Kb)


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


Сообщение отредактировал _Boroda_ - Среда, 24.04.2019, 11:06
 
Ответить
СообщениеТак попробуйте
[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
[/vba]

*Чуть поправил

Автор - _Boroda_
Дата добавления - 24.04.2019 в 11:03
bmv98rus Дата: Среда, 24.04.2019, 11:10 | Сообщение № 8
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4099
Репутация: 766 ±
Замечаний: 0% ±

Excel 2013/2016
Да и забыл совсем, все хорошо, кроме сброса UNDO стека. При отработке этого.

_Boroda_, Саш Если For Each , то EnableEvents за его пределы лучше. Чего дергать каждый раз.
Ээээ подправил но не до конца :-)


Замечательный Временно просто медведь , процентов на 20.

Сообщение отредактировал bmv98rus - Среда, 24.04.2019, 11:10
 
Ответить
СообщениеДа и забыл совсем, все хорошо, кроме сброса UNDO стека. При отработке этого.

_Boroda_, Саш Если For Each , то EnableEvents за его пределы лучше. Чего дергать каждый раз.
Ээээ подправил но не до конца :-)

Автор - bmv98rus
Дата добавления - 24.04.2019 в 11:10
DrMini Дата: Среда, 24.04.2019, 11:17 | Сообщение № 9
Группа: Проверенные
Ранг: Старожил
Сообщений: 1609
Репутация: 195 ±
Замечаний: 0% ±

Excel LTSC 2024 RUS
Александр. Всё работает. Спасибо. Подскажите пожалуйста что надо изменить, что бы макрос работал в другом столбце. А лучше в интервале ( с 5-ой строки и ниже).
 
Ответить
СообщениеАлександр. Всё работает. Спасибо. Подскажите пожалуйста что надо изменить, что бы макрос работал в другом столбце. А лучше в интервале ( с 5-ой строки и ниже).

Автор - DrMini
Дата добавления - 24.04.2019 в 11:17
_Boroda_ Дата: Среда, 24.04.2019, 11:25 | Сообщение № 10
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Чего дергать каждый раз
Согласен
[vba]
Код
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
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение
Чего дергать каждый раз
Согласен
[vba]
Код
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
[/vba]

Автор - _Boroda_
Дата добавления - 24.04.2019 в 11:25
DrMini Дата: Среда, 24.04.2019, 11:32 | Сообщение № 11
Группа: Проверенные
Ранг: Старожил
Сообщений: 1609
Репутация: 195 ±
Замечаний: 0% ±

Excel LTSC 2024 RUS
Александр и Михаил огромное Вам спасибо!
 
Ответить
СообщениеАлександр и Михаил огромное Вам спасибо!

Автор - DrMini
Дата добавления - 24.04.2019 в 11:32
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Номера телефонов через формат ячейки макросом (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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