quyenpv
Thu nhặt kiến thức
- Tham gia
- 5/1/13
- Bài viết
- 719
- Được thích
- 97
- Giới tính
- Nam
- Nghề nghiệp
- Decode cuộc đời!
Dear các anh chị!
Em chắp vá và xào nấu Sub chuyển đổi số điện thoại theo mã mới đã chạy tốt trên mã di động, tuy nhiên động vào mã Cố định không theo quy tắc nào cả nên code chạy không đúng
Lý do làm việc này vì em có danh sách gần 1000 khách hàng cần theo dõi, tuy nhiên số điện thoại lung tung hết và không được cập nhật nhiều khi không nhớ mã cũ đổi sang mã mới là gì lại phải Google tra ạ
Em nhờ anh chị xem và hoàn thiện, sửa lỗi giúp em. Cái này chắc cũng có anh chị em nào cần ạ
Em cám ơn
Em chắp vá và xào nấu Sub chuyển đổi số điện thoại theo mã mới đã chạy tốt trên mã di động, tuy nhiên động vào mã Cố định không theo quy tắc nào cả nên code chạy không đúng
Lý do làm việc này vì em có danh sách gần 1000 khách hàng cần theo dõi, tuy nhiên số điện thoại lung tung hết và không được cập nhật nhiều khi không nhớ mã cũ đổi sang mã mới là gì lại phải Google tra ạ
Em nhờ anh chị xem và hoàn thiện, sửa lỗi giúp em. Cái này chắc cũng có anh chị em nào cần ạ
Em cám ơn
Mã:
Sub Format_ParenWrapper()
'<EhHeader>
On Error GoTo ParenWrapper_Err
'</EhHeader>
Dim cell As Range
Dim key As String
Dim flag As Boolean
flag = False
For Each cell In Selection
If IsError(cell) = False Then
If Len(RemoveNonNumeric(CStr(cell))) = 10 Or Len(RemoveNonNumeric(CStr(cell))) = 11 Then
cell = Paren(cell.Value)
Else
flag = True
End If
End If
Next cell
If flag = True Then
MsgBox "So Dien thoai sai dinh dang"
End If
'<EhFooter>
Exit Sub
ParenWrapper_Err:
MsgBox Err.Description & vbCrLf & _
"in excelphone.Phone.ParenWrapper " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'</EhFooter>
End Sub
Function Paren(s As String) As String
'<EhHeader>
On Error GoTo Paren_Err
'</EhHeader>
Dim stripped As String
Dim s1, s2, s3 As String
Dim s4 As String
stripped = RemoveNonNumeric(s)
If Len(CStr(stripped)) = 10 Then
s1 = VBA.Mid(stripped, 1, 3)
If s1 = "064" Then
s1 = "0254"
ElseIf s1 = "254" Then
s1 = "0254"
ElseIf VBA.Left(s1, 2) = "64" Then
s1 = "0254"
End If
s2 = VBA.Mid(stripped, 4, 3)
s3 = VBA.Mid(stripped, 7, 4)
Paren = "(" & s1 & ") " & s2 & "-" & s3
ElseIf Len(CStr(stripped)) = 11 Then
stripped = Convert11to10(stripped)
s1 = VBA.Mid(stripped, 1, 3)
s2 = VBA.Mid(stripped, 4, 3)
s3 = VBA.Mid(stripped, 7, 4)
Paren = "(" & s1 & ") " & s2 & "-" & s3
Else
Paren = s
End If
'<EhFooter>
Exit Function
Paren_Err:
MsgBox Err.Description & vbCrLf & _
"in excelphone.Phone.Paren " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'</EhFooter>
End Function
Function RemoveNonNumeric(s As String)
' ns-97' becomes 'ns-'
RemoveNonNumeric = StringSieve(s, "0123456789", True)
End Function
Function StringSieve(ByVal Text As String, ByVal Filter As String, Optional ByVal ReturnFilterItems As Boolean = True) As String
'<EhHeader>
On Error GoTo StringSieve_Err
'</EhHeader>
Dim intCharPos As Integer
Dim strChar As String
StringSieve = ""
For intCharPos = 1 To Len(Text)
strChar = VBA.Mid$(Text, intCharPos, 1)
If ReturnFilterItems Then
If InStr(Filter, strChar) <> 0 Then
StringSieve = StringSieve & strChar
End If
Else
If InStr(Filter, strChar) = 0 Then
StringSieve = StringSieve & strChar
End If
End If
Next
'<EhFooter>
Exit Function
StringSieve_Err:
MsgBox Err.Description & vbCrLf & _
"in excelphone.Phone.StringSieve " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'</EhFooter>
End Function
Function Convert11to10(s As String) As String
'<EhHeader>
On Error GoTo Dash_Err
'</EhHeader>
Dim stripped As String
Dim s1, s2, s3 As String
Dim s4 As String
stripped = RemoveNonNumeric(s)
If Len(CStr(stripped)) = 10 Then
s1 = VBA.Mid(stripped, 1, 3)
s2 = VBA.Mid(stripped, 4, 8)
If s1 = "064" Then
s1 = "0254"
ElseIf s1 = "254" Then
s1 = "0254"
ElseIf VBA.Left(s1, 2) = "64" Then
s1 = "0254"
End If
Convert11to10 = s1 & s2
ElseIf Len(CStr(stripped)) = 11 Then
s1 = VBA.Mid(stripped, 1, 4)
s2 = VBA.Mid(stripped, 5, 8)
If s1 = "0169" Then
s1 = "039"
ElseIf s1 = "0168" Then
s1 = "038"
ElseIf s1 = "0167" Then
s1 = "037"
ElseIf s1 = "0166" Then
s1 = "036"
ElseIf s1 = "0165" Then
s1 = "035"
ElseIf s1 = "0164" Then
s1 = "034"
ElseIf s1 = "0163" Then
s1 = "033"
ElseIf s1 = "0162" Then
s1 = "032"
ElseIf s1 = "0120" Then
s1 = "070"
ElseIf s1 = "0121" Then
s1 = "079"
ElseIf s1 = "0122" Then
s1 = "077"
ElseIf s1 = "0126" Then
s1 = "076"
ElseIf s1 = "0128" Then
s1 = "078"
ElseIf s1 = "0123" Then
s1 = "083"
ElseIf s1 = "0124" Then
s1 = "084"
ElseIf s1 = "0125" Then
s1 = "085"
ElseIf s1 = "0127" Then
s1 = "081"
ElseIf s1 = "0129" Then
s1 = "082"
ElseIf s1 = "01992" Then
s1 = "059"
ElseIf s1 = "01993" Then
s1 = "059"
ElseIf s1 = "01998" Then
s1 = "059"
ElseIf s1 = "01999" Then
s1 = "059"
ElseIf s1 = "0186" Then
s1 = "056"
ElseIf s1 = "0188" Then
s1 = "058"
End If
Convert11to10 = s1 & s2
Else
Convert11to10 = s
End If
'<EhFooter>
Exit Function
Dash_Err:
MsgBox Err.Description & vbCrLf & _
"in excelphone.Phone.Dash " & _
"at line " & Erl, _
vbExclamation + vbOKOnly, "Application Error"
Resume Next
'</EhFooter>
End Function
.
