Все мы видели рекламу по телевизору: «Позвоните по телефону 1-800 — ПОЛУЧИТЕ, чтобы получить набор сверхострых ножей». Вы можете столкнуться с необходимостью преобразовать телефонные номера из текстовой версии (как показано в объявлениях) в номера, представленные этим текстом. Следующий макрос, DoPhone, выполнит магию преобразования за вас:

Sub DoPhone()

Dim rngSrc As Range     Dim lMax As Long, lCtr As Long     Dim J As Integer     Dim Phone As String, Digit As String

Set rngSrc = ActiveSheet.Range(ActiveWindow.Selection.Address)

lMax = rngSrc.Cells.Count

For lCtr = 1 To lMax         If Not rngSrc.Cells(lCtr).HasFormula Then             Phone = rngSrc.Cells(lCtr).Value             For J = 1 To Len(Phone)

Digit = Ucase(Mid(Phone, J, 1))

Select Case Digit                     Case "A" To "P"

Digit = Chr((Asc(Digit) + 1) \ 3 + 28)

Case "Q"

Digit = "7"     'May want to change                     Case "R" To "Y"

Digit = Chr(Asc(Digit) \ 3 + 28)

Case "Z"

Digit = "9"     'May want to change                 End Select                 Mid(Phone, J, 1) = Digit             Next J             rngSrc.Cells(lCtr).Value = Phone         End If     Next lCtr End Sub

Процедура DoPhone пытается преобразовать информацию в любой ячейке, не содержащей формулы. Все, что вам нужно сделать, это выбрать ячейку (или ячейки), которые вы хотите преобразовать, а затем запустить процедуру. В результате любой текст в ячейках преобразуется в их цифровые эквиваленты на телефоне. Таким образом, 598-TIPS становится 598-8477.

Следует отметить одну небольшую особенность DoPhone, которую вы можете изменить. Некоторые телефоны распознают буквы Q и Z как цифры 7 и 9 соответственно. Другие просто оставляют эти цифры или преобразуют их в 0. DoPhone, как написано здесь, преобразует эти буквы в 7 и 9. Вы можете изменить соответствующие места в структуре Select Case, если хотите, чтобы они были заменены на числа в соответствии с к вашим потребностям. (Соответствующие места прокомментированы в листинге.)

_Примечание: _

Если вы хотите узнать, как использовать макросы, описанные на этой странице (или на любой другой странице на сайтах ExcelTips), я подготовил специальную страницу, содержащую полезную информацию.

link: / excelribbon-ExcelTipsMacros [Щелкните здесь, чтобы открыть эту специальную страницу в новой вкладке браузера].

ExcelTips — ваш источник экономичного обучения Microsoft Excel.

Этот совет (11802) применим к Microsoft Excel 2007, 2010, 2013 и 2016.

Вы можете найти версию этого совета для старого интерфейса меню Excel здесь:

link: / excel-Converting_Phone_Numbers [преобразование телефонных номеров].