Sub tachdt()
Dim num1 As Long, num2 As Long, num3 As Long, num5 As Long, num6 As Long, num7 As Long
Dim arr1, arr2(1 To 3), arr3
[d2:i60000].Clear: [d:i].NumberFormat = "@"
arr1 = Range("A2:B" & [a60000].End(xlUp).Row)
ReDim arr3(1 To UBound(arr1), 1 To 6)
arr2(1) = "\b(098|097|096|0169|0168|0167|0166|0165|0164|0163|0162|086).*" 'viettel
arr2(2) = "\b(091|094|0123|0124|0125|0127|0129|088).*" 'vina
arr2(3) = "\b(090|093|0120|0121|0122|0126|0128|089).*" 'mobi
With CreateObject("vbscript.regexp")
.Global = True
For num1 = 1 To UBound(arr1)
For num2 = 1 To 3
.Pattern = arr2(num2)
If .test(arr1(num1, 1)) Then
Select Case num2
Case 1: num5 = num5 + 1: num3 = num5
Case 2: num6 = num6 + 1: num3 = num6
Case 3: num7 = num7 + 1: num3 = num7
End Select
arr3(num3, num2 * 2 - 1) = arr1(num1, 2): arr3(num3, num2 * 2) = arr1(num1, 1)
End If
Next num2
Next num1
End With
If WorksheetFunction.Max(num5, num6, num7) > 0 Then
[d2].Resize(WorksheetFunction.Max(num5, num6, num7), 6) = arr3
[d1].Resize(WorksheetFunction.Max(num5, num6, num7) + 1, 6).Borders.LineStyle = 1
End If
End Sub
