Sub hhh()
Dim a As Range
Dim b As Range
Set a = Selection
For Each b In a
With b
b.Value = "'" + b.Text
.Replace what:="/", replacement:=""
.Replace what:="\", replacement:=""
.Replace what:=")", replacement:=""
.Replace what:="(", replacement:=""
.Replace what:="+", replacement:=""
.Replace what:=" ", replacement:=""
.Replace what:="-", replacement:=""
.Value = "7" + Right(.Text, 10)
.NumberFormat = "@"
End With
Next
End Sub
выделяете нужный диапазон с данными и запускаете макрос
Добрый вечер! Анастасия очень сильно помогла мне. Использую ее макрос, все прекрасно работает, но тут появился вопрос, а как быть с городскими номерами? Вот если есть "3485259", а нужно "4993485259" Прикладываю файл, с макросом Анастасии. Может кто помочь доработать, чтобы можно было добавлять в макрос например "3595952" - тогда "4953595952" То есть под каждые первые 3 цифры свой код города. Спасибо!
Вот как раз и нет ( В этом-то и беда, нужно и прошлый код оставить и одновременно с этим же кодом добавить чтобы к разным первым цифрам, притягивалось либо "499", либо "495".
Kuzmich, спасибо Вам за прошлый макрос, его Андрей доработал и стало просто красота, очень спасает!
Коды 495 и 499 относятся к Москве. Первоначально телефоны Москвы имели код города 095, затем 495. При разделении на 499 перешли, примерно, номера телефонов в районах севернее Москвы-реки. Сейчас определение первых 3 цифр по последним 7 цифрам не представляется возможным.
"320" - "495" "348" - "499" "356" - "499" "357" - "499" Вы можете прописать допустим только эти 4, а я уже смогу копировать в коде и вставлять уже другие значения, чтобы Вам не заморачиваться. Мне непонятно как сам код построить, чтобы прошлый тоже работал.
И вот ситуация с "84993562559" чтобы было "4993562559"
Андрей VG написал: а с чего вы решили, что это мобильный номер?
Да, действительно, извиняюсь, не внимательно посмотрел. Тогда "499" Ну тут моментов может быть много, поэтому я и спрашивал, чтобы можно было редактировать и добавлять к разным вариантам исходы. Спасибо за внимательность!
burov_oleg написал: Ну тут моментов может быть много, поэтому я и спрашивал
Вы эти моменты должны найти и определить, что с ними делать. Это ваши данные, только вы в курске - что с ними делать. Предлагаю - 9 значные выгружать на отдельный лист и отправлять поставщику данных с удержанием зарплаты в фонд форума
С удовольствием бы... только поставщик и заказчик и исполнитель все в одном лице я ((( а возможностей таких не имею ( Так вообще идея хорошая, я в следующий раз обязательно задумаюсь над этим!
с 9-ти значным номером решайте сами Попробуйте такой код с выделенным диапазоном
Код
Sub iPhone()
Dim re As Object
Dim tempPhone As String
Dim arr
Dim cell As Range
Dim RgxPhone As String
Set arr = Selection
Selection.Interior.ColorIndex = xlNone
For Each cell In arr
Set re = CreateObject("vbscript.regexp")
re.Pattern = "(-|\s|\+|\(|\))"
re.Global = True
re.IgnoreCase = True
tempPhone = re.Replace(cell, "")
re.Pattern = "(8|7)+(\d{3})+(\d{7})"
RgxPhone = re.Replace(tempPhone, "$2$3")
If Len(RgxPhone) > 10 Then
cell.Interior.ColorIndex = 6:
Else
If Len(RgxPhone) = 10 Then
cell = "7" & RgxPhone
Else
If Len(RgxPhone) = 7 Then
Select Case Left(RgxPhone, 3)
Case "320", "349"
cell = "495" & RgxPhone
Case "348", "356", "357"
cell = "499" & RgxPhone
End Select
End If
End If
End If
Next
End Sub
Public Sub PhoneToTrue()
Dim pClear As Object, lastId As Long, pos As Long
Dim vData, i As Long, j As Long, k As Long
Dim vOut() As Variant, sPhone As String, vItem As Variant
Dim rowIds() As Long, subStrs() As String, outRange As Range
Set pClear = CreateObject("VBScript.RegExp")
pClear.Global = True: pClear.Pattern = "[\(\+\-\) ]"
vData = Selection
ReDim vOut(1 To 2 * UBound(vData, 1), 1 To UBound(vData, 2))
ReDim rowIds(1 To UBound(vData, 2))
For i = 1 To UBound(vData, 1)
For j = 1 To UBound(vData, 2)
sPhone = Replace$(pClear.Replace(vData(i, j), ""), "\", "/")
subStrs = Split(sPhone, "/")
For k = 0 To UBound(subStrs)
sPhone = Right$(subStrs(k), 10)
If Len(sPhone) = 10 Then
vItem = "7" & sPhone
ElseIf Len(sPhone) = 7 Then
Select Case Int(Left$(sPhone, 3))
Case 320, 349: vItem = "7495" & sPhone
Case 348, 356, 357: vItem = "7499" & sPhone
Case Else: vItem = sPhone
End Select
Else
vItem = Empty
End If
rowIds(j) = rowIds(j) + 1
If rowIds(j) > lastId Then lastId = rowIds(j)
vOut(rowIds(j), j) = vItem
Next
Next
Next
Set outRange = ActiveSheet.Cells(Selection.Row, Selection.Column).Resize(lastId, UBound(vData, 2))
outRange.NumberFormat = "@"
outRange.Value = vOut
End Sub