excel_lv1.5
Thành viên tích cực


- Tham gia
- 20/10/17
- Bài viết
- 931
- Được thích
- 1,753
- Giới tính
- Nam
Số điện thoại có 10 số thì sao bạn?Nãy rảnh task xíu mình viết lại code. Bạn nào thích thì viết lại thành Function cho bạn ấy.
Mã:Option Explicit Private Sub mainPROCEDUCE() On Error Resume Next 'Add "Microsoft Visual Basic for Applications Extensibility 5.3" Call AddVBE 'Add "Microsoft VBScript Regular Expressions 5.5" library Call AddReference Call getPhoneNumber End Sub Private Sub AddVBE() Dim vbProj, chkRef Dim BoolExists As Boolean Set vbProj = ActiveWorkbook.VBProject '~~> Check if "Microsoft Visual Basic for Applications Extensibility 5.3" is already added For Each chkRef In vbProj.References If chkRef.Name = "Microsoft Visual Basic for Applications Extensibility 5.3" Then BoolExists = True GoTo CleanUp End If Next vbProj.References.AddFromGuid "{0002E157-0000-0000-C000-000000000046}", 0, 0 CleanUp: If BoolExists = True Then MsgBox "Reference already exists" Else MsgBox "Reference Added Successfully" End If Set vbProj = Nothing End Sub Private Sub AddReference() Dim VBAEditor As VBIDE.VBE Dim vbProj As VBIDE.VBProject Dim chkRef As VBIDE.Reference Dim BoolExists As Boolean Set VBAEditor = Application.VBE Set vbProj = ActiveWorkbook.VBProject '~~> Check if "Microsoft VBScript Regular Expressions 5.5" is already added For Each chkRef In vbProj.References If chkRef.Name = "VBScript_RegExp_55" Then BoolExists = True GoTo CleanUp End If Next vbProj.References.AddFromFile "C:\WINDOWS\system32\vbscript.dll\3" CleanUp: If BoolExists = True Then MsgBox "Reference already exists" Else MsgBox "Reference Added Successfully" End If Set vbProj = Nothing Set VBAEditor = Nothing End Sub Private Sub getPhoneNumber() Dim regex As Object, RNG, firstRNG As Range, firstROW As Integer, lastROW As Long, strDATA As String Dim Match, matches As Object Set regex = CreateObject("VBScript.RegExp") Set firstRNG = ThisWorkbook.Worksheets("DATA").Range("firstRNG") firstROW = 1 lastROW = firstRNG.CurrentRegion.Rows.Count For RNG = firstROW To lastROW strDATA = ThisWorkbook.Worksheets("DATA").Range("C" & RNG) Set matches = regex.Execute(strDATA) With regex .Pattern = "(?:(\s)\d\d\s*\-*\d\s*\-*\d\s*\-*\d\s*\-*\d\s*\-*\d\s*\-*\d\s*\-*\d\s*\-*\d\s*\-*\d)" .Global = True End With For Each Match In matches Debug.Print Match.Value ' Next Match Next RNG End Sub [\code]