Nhờ mọi người giúp mình macro đổi đầu số đt ạ

kimdong80 · 1/8/19

Mình có danh sách KH cũ với mọi định dạng khác nhau như vd bên dưới:
1651234567
903456789
01234567891/0912349892
98734562 (số thiếu)
0938763972- 0124456970
Mình muốn với những số như dòng 1 thì sẽ tự đổi đầu thành 0351234567
Dòng 2 thì chỉ thêm số 0-> 0903456789
Dòng 3 thì chỉ lấy số trc dấu / và nếu định dạng 11 số thì chuyển về định dạng 10 số
Dòng 4 là số thiếu thì tô vàng dòng đó
Dòng 5 thì lấy số trc dấu - và nếu 11 số thì đổi sang 10 số.
Cám ơn mọi người rất nhiều

snow25 · 1/8/19

kimdong80 đã viết:
Mình có danh sách KH cũ với mọi định dạng khác nhau như vd bên dưới:
1651234567
903456789
01234567891/0912349892
98734562 (số thiếu)
0938763972- 0124456970
Mình muốn với những số như dòng 1 thì sẽ tự đổi đầu thành 0351234567
Dòng 2 thì chỉ thêm số 0-> 0903456789
Dòng 3 thì chỉ lấy số trc dấu / và nếu định dạng 11 số thì chuyển về định dạng 10 số
Dòng 4 là số thiếu thì tô vàng dòng đó
Dòng 5 thì lấy số trc dấu - và nếu 11 số thì đổi sang 10 số.
Cám ơn mọi người rất nhiều

Thế dữ liệu đâu ta.Mà dữ liệu phải có bảng quy đổi số điện thoại nhé.

kimdong80 · 1/8/19

snow25 đã viết:
Thế dữ liệu đâu ta.Mà dữ liệu phải có bảng quy đổi số điện thoại nhé.

Mình gửi bạn file mẫu, bạn xem giúp mình nhé. Cám ơn bạn nhiều

SA_DQ · 2/8/19

Viết (4) macro cho từng trường hợp thì chắc ăn hơn cả!

Mà hình như phải là >=5 (M) thì phải!

snow25 · 2/8/19

kimdong80 đã viết:
Mình gửi bạn file mẫu, bạn xem giúp mình nhé. Cám ơn bạn nhiều

Bạn thử cái code này nhé.

Mã:

Sub tachso()
    Dim arr, i As Long, lr As Long, dic As Object, kq, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets(2)
        arr = .Range("A3:B23").Value
        For i = 1 To UBound(arr, 1)
            dk = arr(i, 1)
            dic.Item(dk) = arr(i, 2)
        Next i
    End With
    With Sheets(1)
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        arr = .Range("A2:B" & lr).Value
        For i = 1 To UBound(arr)
            arr(i, 2) = quydoi(arr(i, 1))
            If Len(arr(i, 2)) = 11 Then
               dk = Left(arr(i, 2), 4)
               If dic.exists(dk) Then
                  arr(i, 2) = dic.Item(dk) & Right(arr(i, 2), 7)
               Else
                   arr(i, 2) = "so quy doi bi loi"
               End If
            ElseIf Len(arr(i, 2)) = 10 Then
                  arr(i, 2) = arr(i, 2)
            Else
                 arr(i, 2) = "So khong dung"
            End If
     Next i
        .Range("A2:B" & lr).Value = arr
    End With
End Sub
Function quydoi(ByVal dk As String)
      Dim s As String, a As Integer
      s = Replace(dk, "-", "/")
      s = Replace(s, ".", "/")
      a = InStr(s, "/")
      If a Then
         s = Left(s, a - 1)
      End If
      If CLng(Left(s, 1)) <> 0 Then
         s = "0" & s
      End If
      quydoi = Application.Trim(s)
End Function

kimdong80 · 4/8/19

snow25 đã viết:

Bạn thử cái code này nhé.

Mã:

Sub tachso()
    Dim arr, i As Long, lr As Long, dic As Object, kq, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets(2)
        arr = .Range("A3:B23").Value
        For i = 1 To UBound(arr, 1)
            dk = arr(i, 1)
            dic.Item(dk) = arr(i, 2)
        Next i
    End With
    With Sheets(1)
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        arr = .Range("A2:B" & lr).Value
        For i = 1 To UBound(arr)
            arr(i, 2) = quydoi(arr(i, 1))
            If Len(arr(i, 2)) = 11 Then
               dk = Left(arr(i, 2), 4)
               If dic.exists(dk) Then
                  arr(i, 2) = dic.Item(dk) & Right(arr(i, 2), 7)
               Else
                   arr(i, 2) = "so quy doi bi loi"
               End If
            ElseIf Len(arr(i, 2)) = 10 Then
                  arr(i, 2) = arr(i, 2)
            Else
                 arr(i, 2) = "So khong dung"
            End If
     Next i
        .Range("A2:B" & lr).Value = arr
    End With
End Sub
Function quydoi(ByVal dk As String)
      Dim s As String, a As Integer
      s = Replace(dk, "-", "/")
      s = Replace(s, ".", "/")
      a = InStr(s, "/")
      If a Then
         s = Left(s, a - 1)
      End If
      If CLng(Left(s, 1)) <> 0 Then
         s = "0" & s
      End If
      quydoi = Application.Trim(s)
End Function

Cám ơn bạn rất nhiều. Mình đã làm được rồi. Không biết bạn có thể giúp mình thêm 1 lần nữa không? Mình có 1 file khác. Trong đó Sheet Lan 2 thì có mã KH, mình muốn nếu tìm mã KH đó trong sheet 2-2. Nếu không có trong sheet 2-2 thì cột Check sẽ hiện "đã check". Đồng thời sẽ tìm trong Sheet tên KH. Nếu tên KH là Chị Hương hoặc Lê Anh Thư Thì Cột Check sẽ hiện ra tên KH tương ứng. Nếu không thỏa dk nào thì để trống. Bạn giúp dùm mình 1 lần nữa nhé. 1 lần nữa mình cám ơn bạn rất nhiều

SA_DQ · 5/8/19

PHP:

Sub CheckIn2()
 Dim Cls As Range, sRng As Range, Rng As Range, Rg4 As Range
 Dim Ten As String, MyAdd As String

 Sheets("Lan 2-1").Select
 With Sheets("Lan 2-2")
    Set Rng = .Range(.[b1], .[b1].End(xlDown))
  End With
  With Sheet4
    Set Rg4 = .Range(.[A1], .[A1].End(xlDown))
  End With
  For Each Cls In Range([B2], [B2].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        Cls.Offset(, 1).Value = "Check Xong!"
    End If
    Set sRng = Rg4.Find(Cls.Value)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            Ten = Mid(sRng.Offset(, 1).Value, 4, 2)
            If Ten = " H" Or Ten = "An" Then
                Cls.Offset(, 1).Value = Cls.Offset(, 1).Value & Space(1) & sRng.Offset(, 1).Value
            End If
            Set sRng = Rg4.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
  Next Cls
End Sub

& bạn nên sửa lại tiêu đề bài viết cho rõ nghĩa thệm đi nha.

kimdong80 · 5/8/19

Trong macro đổi đầu số đt nếu số đt viết ntn 0909123456 098768271 ( tức là chỉ có dấu cách ở giữa) thì nó báo số ko đúng, làm sao để mình fix cái đó vậy bạn. Or trường hợp số 091876543-09329819 thì số đàng trước thiếu số, nó cũng báo số ko đúng. Mình có thể thêm dk nếu số đầu ko đúng thì lấy số sau dc ko?

SA_DQ đã viết:

PHP:

Sub CheckIn2()
Dim Cls As Range, sRng As Range, Rng As Range, Rg4 As Range
Dim Ten As String, MyAdd As String

Sheets("Lan 2-1").Select
With Sheets("Lan 2-2")
    Set Rng = .Range(.[b1], .[b1].End(xlDown))
  End With
  With Sheet4
    Set Rg4 = .Range(.[A1], .[A1].End(xlDown))
  End With
  For Each Cls In Range([B2], [B2].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        Cls.Offset(, 1).Value = "Check Xong!"
    End If
    Set sRng = Rg4.Find(Cls.Value)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            Ten = Mid(sRng.Offset(, 1).Value, 4, 2)
            If Ten = " H" Or Ten = "An" Then
                Cls.Offset(, 1).Value = Cls.Offset(, 1).Value & Space(1) & sRng.Offset(, 1).Value
            End If
            Set sRng = Rg4.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
  Next Cls
End Sub

& bạn nên sửa lại tiêu đề bài viết cho rõ nghĩa thệm đi nha.

Trong macro đổi đầu số đt nếu số đt viết ntn 0909123456 098768271 ( tức là chỉ có dấu cách ở giữa) thì nó báo số ko đúng, làm sao để mình fix cái đó vậy bạn. Or trường hợp số 091876543-09329819 thì số đàng trước thiếu số, nó cũng báo số ko đúng. Mình có thể thêm dk nếu số đầu ko đúng thì lấy số sau dc ko?

kimdong80 · 6/8/19

SA_DQ đã viết:

PHP:

Sub CheckIn2()
Dim Cls As Range, sRng As Range, Rng As Range, Rg4 As Range
Dim Ten As String, MyAdd As String

Sheets("Lan 2-1").Select
With Sheets("Lan 2-2")
    Set Rng = .Range(.[b1], .[b1].End(xlDown))
  End With
  With Sheet4
    Set Rg4 = .Range(.[A1], .[A1].End(xlDown))
  End With
  For Each Cls In Range([B2], [B2].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        Cls.Offset(, 1).Value = "Check Xong!"
    End If
    Set sRng = Rg4.Find(Cls.Value)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            Ten = Mid(sRng.Offset(, 1).Value, 4, 2)
            If Ten = " H" Or Ten = "An" Then
                Cls.Offset(, 1).Value = Cls.Offset(, 1).Value & Space(1) & sRng.Offset(, 1).Value
            End If
            Set sRng = Rg4.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
  Next Cls
End Sub

& bạn nên sửa lại tiêu đề bài viết cho rõ nghĩa thệm đi nha.

Mình làm theo Macro của bạn nhưng kết quả check tên thì nó lại ra ở Sheet lần 2-2, mà chữ Check Xong thì nó cũng ko ra, mặc dù có những cái (như mình tô đò) thì bên Sheet lần 2-2 ko có (thỏa điều kiện). bạn xem lại giúp mình nhé

SA_DQ · 7/8/19

65	KZ031417
66	KZ030626
67	KY003443
68	JY203636	Check Xong!
69	JZ054414
70	KY001816
71	KY034596
72	KY034504
73	KY005120	Check Xong!
74	KY000795
75	KZ031427
76	KZ032447
77	KY050932
78	KZ003191
79	JZ093777
80	KY006035
81	KZ002552

kimdong80 · 7/8/19

SA_DQ đã viết:
65
KZ031417
66
KZ030626
67
KY003443
68
JY203636 Check Xong!
69
JZ054414
70
KY001816
71
KY034596
72
KY034504
73
KY005120 Check Xong!
74
KY000795
75
KZ031427
76
KZ032447
77
KY050932
78
KZ003191
79
JZ093777
80
KY006035
81
KZ002552

Mình làm dc rồi. Cám ơn bạn nhiều nhé

Nhờ mọi người giúp mình macro đổi đầu số đt ạ

kimdong80

Thành viên chính thức

snow25

Thành viên gạo cội

kimdong80

Thành viên chính thức

File đính kèm

SA_DQ

/(hông là gì!

snow25

Thành viên gạo cội

File đính kèm

kimdong80

Thành viên chính thức

File đính kèm

SA_DQ

/(hông là gì!

kimdong80

Thành viên chính thức

kimdong80

Thành viên chính thức

File đính kèm

SA_DQ

/(hông là gì!

kimdong80

Thành viên chính thức

Bài viết mới nhất

Facebook

Group

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng