Question

我正在尝试格式化电话号码，以便从正确的国家/地区代码开始。例如，如果在J2下找到新加坡，我希望K2能够反映出65XXXXXXX（新加坡的国家代码为+65）。国家位于J列，数字位于K列。

作为VBA的一个白痴，我绕着网络编写了一个符合我目的的代码。快到了！但是当数字已经有正确的国家代码时会出错！如果已经存在正确的国家/地区代码，我想保留该号码。

任何人都可以为我破解它吗？

Sub CountryCodes()


Set wS5 = Sheets("Country_Codes")

Dim arr1()
Dim arr2()

arr1 = Array("Singapore", "Austria", "United Kingdom", "Denmark", "Sweden", "Norway", "Poland", "Germany")
arr2 = Array(65, 43, 44, 45, 46, 47, 48, 49)

With wS5
For Each cell In .Range("J2:" & .Range("J2").End(xlDown).Address)
    Found = 0
    For i = 0 To UBound(arr1)
        If cell.Value = arr1(i) Then
            cell.Offset(0, 1).Value = arr2(i) & CInt(cell.Offset(0, 1).Value)
            Found = 1
            Exit For
        End If
    Next

    If Found = 0 Then
        'Country not found in arr1()
        NF = NF & "," & cell.Value
    End If
Next
End With

If Len(NF) > 1 Then
MsgBox "These countries could not be found :" & Right(NF, Len(NF) - 1)
End If

End Sub

我有一个次要问题。我的一些电话号码有空格和“+”，例如+65 XXXX XXXX。我试图让它成为纯粹的数字，没有空间，没有+。有什么办法可以删除这些空格/ +？

非常感谢。票据

Answer 1

试试这个

Option Explicit

Sub CountryCodes()
Dim wS5 As Worksheet
Dim cell As Range
Dim found As Long, i As Long
Dim NF As String

Set wS5 = Sheets("Country_Codes")

Dim arr1()
Dim arr2()

arr1 = Array("Singapore", "Austria", "United Kingdom", "Denmark", "Sweden", "Norway", "Poland", "Germany")
arr2 = Array(65, 43, 44, 45, 46, 47, 48, 49)

With wS5
    With .Range("J2:J" & .Cells(.Rows.Count, "J").End(xlUp).Row).SpecialCells(xlCellTypeConstants, xlTextValues) ' <~~ go down the last row of column "J" (.Cells(.Rows.Count, "J")) and then climb up (.End(xlUp)) to get extend the range to its last non empty cell. finally select only non empty cells (.SpecialCells(xlCellTypeConstants, xlTextValues))
        .Offset(, 1).Replace what:="+", Replacement:="", lookAt:=xlPart ' <~~ remove "+" charachters
        .Offset(, 1).Replace what:=" ", Replacement:="", lookAt:=xlPart '<~~ remove spaces
        For Each cell In .Cells
            found = 0
            For i = 0 To UBound(arr1)
                If cell.Value = arr1(i) Then
                    ' use Left() function to check if the first characters in column K already match the relevant countrycode. 
                    If Left(CStr(cell.Offset(, 1).Value), Len(CStr(arr2(i)))) <> CStr(arr2(i)) Then cell.Offset(, 1).Value = CStr(arr2(i)) & CStr(cell.Offset(, 1).Value) '<~~if they don't then add the countrycode a the left of the string
                    found = 1
                    Exit For
                End If
            Next

            If found = 0 Then NF = NF & "," & cell.Value  'Country not found in arr1()
        Next
    End With
End With

If Len(NF) > 1 Then MsgBox "These countries could not be found :" & Right(NF, Len(NF) - 1)

End Sub

Answer 2

您的部分问题是您使用的是CInt而不是CDbl。

VBA中的整数为16位，因此范围为-32768到32767

然而，将电话号码视为一个长期计划并不是一个好计划。如果你包含国家代码（即我的手机是+44 7980 XXX YYY），英国号码有12位数，所以你甚至会遇到麻烦，甚至CLng高达2,147,483,647。你可能可以使用CDbl，因为这将允许17位数的精度（虽然excel可能会尝试进入科学记数法）。

基本上对于电话号码，您需要将其视为字符串，因为您可能需要处理+65表示国家/地区代码指示，并且可能需要使用xt456作为扩展名......这也意味着您赢了“我需要担心空格（尽管VBA替换功能可以在这里提供帮助）

Answer 3

我首先使用正则表达式清除数字，然后添加国家/地区代码（如果它已丢失）。为了克服溢出问题，我会将数字存储为Decimal，因为它可以容纳28位数字。此外，使用Dictionay / Collection而不是循环查找国家/地区代码会更简单。

以下是使用国家/地区代码格式化电话号码的示例：

Sub CountryCodes()
    Dim re As Object, ws As Worksheet, cell As Range
    Dim country$, countryCode$, number$, NF$

    ' create the country codes dictionary '
    Dim codes As New Collection
    codes.Add 65, "Singapore"
    codes.Add 43, "Austria"
    codes.Add 44, "United Kingdom"
    codes.Add 45, "Denmark"
    codes.Add 46, "Sweden"
    codes.Add 47, "Norway"
    codes.Add 48, "Poland"
    codes.Add 49, "Germany"

    ' create the regular expression to remove the leading "+", "0" and non digit characters '
    Set re = CreateObject("VBScript.RegExp")
    re.Global = True
    re.Pattern = "^[^1-9]|\D"

    Set ws = Sheets("Country_Codes")
    ws.Columns("K").NumberFormat = "0"

    ' iterate each number '
    For Each cell In ws.Range(ws.Cells(2, "K"), ws.Cells(ws.Rows.Count, "K").End(xlUp))
      country = cell.Offset(0, -1).Value
      countryCode = GetCollectionItem(codes, country)
      number = re.Replace(cell.Text, Empty)

      If Len(countryCode) Then
        ' add the country code if not present at the begining '
        If InStr(1, number, countryCode) <> 1 Then number = countryCode & number

        ' write the number back to the sheet as decimal to avoid overflow '
        cell.Value2 = CDec(number)
      Else
        NF = NF & "," & country
      End If
    Next

    If Len(NF) > 1 Then MsgBox "These countries could not be found :" & Mid$(NF, 2)
End Sub


Private Function GetCollectionItem(obj As Collection, key As String)
    On Error Resume Next
    GetCollectionItem = obj(key)
End Function

破解：运行时错误6溢出

3 个答案: