[Help] Tạo Marco kiểm tra đầu số điện thoại (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

robinhsoon

Thành viên hoạt động
Tham gia
19/1/16
Bài viết
153
Được thích
11
Xin chào các Thầy cộng đồng mạng Giaiphapexcel.!

Em có một bài toán nhưng tìm hoài mà không có cách nào giải quyết, nên em đăng bài này mong các thầy giúp đỡ..

Trong file đính kèm của em đó là Data thực tế mà hiện tại em đang làm.. gồm 02 sheet
công việc:
1.Tại Sheet (Data): Kiểm tra độ dài của các số điện thoại ở cột Hand Phone, nếu là độ dài bằng 10 hoặc 11 số (đúng) thì kiểm tra lần lượt các đầu số điện thoại đã khai báo trong thư viện Sheet (Check Phone) nếu trùng với các đầu số thì đúng và ngược lại nếu sai thì Highline vàng các số điện thoại lên..

2. Do Template của em không có định nên thây vì tìm và xử lý một cột cố định em sẽ thay vào là tìm đến cột có Tên là Handphone (hoặc có cách nào hay hơn mong các thầy cho em ý kiến ạ)

Chân thành cảm ơn các Thầy ạ.!.
 

File đính kèm

Hổng phải thầy làm được hông?
PHP:
Sub GPE()
Dim Arr(), Cll As Range, I As Long, J As Long, Num As Long, Tem As String, DK As Boolean
Arr = Sheet2.Range("A3:B33").Value
Tem = Sheet2.Range("A2").Value
For Each Cll In Range("C2", Range("C2").End(xlDown))
    DK = False
    J = IIf(InStr(Tem, Cll.Offset(, -1).Value), 1, 2)
    Num = IIf(J = 1, 8, 7)
    If Len(Cll) <> Num Then
        Cll.Interior.ColorIndex = 3
    Else
        For I = 1 To UBound(Arr)
            If Cll.Value Like Arr(I, J) & "*" Then
                DK = True: Exit For
            End If
        Next I
        If DK = False Then Cll.Interior.ColorIndex = 3
    End If
Next
End Sub

HiHi, Cảm ơn Thầy nhé, đã giải quyết được vấn đề bên trên của em rồi ạ..

Còn một thắc mắc nữa ạ... Thây vì tìm tới cột cố định là cột C, e muốn tìm tới tên của cột là Dien Thoai Ban thì em sửa code sao ạ..

Mong Thầy giúp đỡ ạ..
 
Upvote 0
Hổng phải thầy làm được hông?
PHP:
Sub GPE()
Dim Arr(), Cll As Range, I As Long, J As Long, Num As Long, Tem As String, DK As Boolean
Arr = Sheet2.Range("A3:B33").Value
Tem = Sheet2.Range("A2").Value
For Each Cll In Range("C2", Range("C2").End(xlDown))
    DK = False
    J = IIf(InStr(Tem, Cll.Offset(, -1).Value), 1, 2)
    Num = IIf(J = 1, 8, 7)
    If Len(Cll) <> Num Then
        Cll.Interior.ColorIndex = 3
    Else
        For I = 1 To UBound(Arr)
            If Cll.Value Like Arr(I, J) & "*" Then
                DK = True: Exit For
            End If
        Next I
        If DK = False Then Cll.Interior.ColorIndex = 3
    End If
Next
End Sub
Bài này chơi....một vòng lặp được hông ???
Thân
 
Upvote 0
HiHi, Cảm ơn Thầy nhé, đã giải quyết được vấn đề bên trên của em rồi ạ..

Còn một thắc mắc nữa ạ... Thây vì tìm tới cột cố định là cột C, e muốn tìm tới tên của cột là Dien Thoai Ban thì em sửa code sao ạ..

Mong Thầy giúp đỡ ạ..

Mong Thầy giúp đỡ ạ..
 
Upvote 0
Hổng phải thầy làm được hông?
PHP:
Sub GPE()
Dim Arr(), Cll As Range, I As Long, J As Long, Num As Long, Tem As String, DK As Boolean
Arr = Sheet2.Range("A3:B33").Value
Tem = Sheet2.Range("A2").Value
For Each Cll In Range("C2", Range("C2").End(xlDown))
    DK = False
    J = IIf(InStr(Tem, Cll.Offset(, -1).Value), 1, 2)
    Num = IIf(J = 1, 8, 7)
    If Len(Cll) <> Num Then
        Cll.Interior.ColorIndex = 3
    Else
        For I = 1 To UBound(Arr)
            If Cll.Value Like Arr(I, J) & "*" Then
                DK = True: Exit For
            End If
        Next I
        If DK = False Then Cll.Interior.ColorIndex = 3
    End If
Next
End Sub

Còn một bước cuối nữa có ai giúp em không ạ...
Thây vì chọn cột cố định là Cột C, em muốn tìm đến cột có tên là Dien Thoai bàn...
Các Pro giúp em sửa đoạn code ạ
 

File đính kèm

Upvote 0
Còn một bước cuối nữa có ai giúp em không ạ...
Thây vì chọn cột cố định là Cột C, em muốn tìm đến cột có tên là Dien Thoai bàn...
Các Pro giúp em sửa đoạn code ạ
"Dien thoai ban" là không dấu, nằm tại dòng 1
Thêm đoạn màu xanh, sửa đoạn màu nâu.
Chém đại vài dòng, sai đâu sửa đấy.
Mã:
.....
Tem = Sheet2.Range("A2").Value
[COLOR=#008080][B]Dim Col[/B]
[B]For Each Cll In Range("A1", Range("A1").End(xlToRight))[/B]
[B]If Cll = "Dien thoai ban" Then Col = Cll.Column[/B]
[B]Next Cll
[/B][/COLOR][COLOR=#a52a2a][B]For Each Cll In Range("A2", Range("A2").End(xlDown)).Offset(, Col - 1)[/B][/COLOR]
DK = False
.....
 
Upvote 0
Còn một bước cuối nữa có ai giúp em không ạ...
Thây vì chọn cột cố định là Cột C, em muốn tìm đến cột có tên là Dien Thoai bàn...
Các Pro giúp em sửa đoạn code ạ
Mã:
Sub GPE()
Dim Rng As Range, C As Range, jC As Long, Col As Long, DauSo As String, Tmp As String, DK As Boolean
Tmp = "Dien thoai ban"
Set C = Sheet1.Range("A1:AX1").Find(Tmp, , xlValues, xlPart)
If Not C Is Nothing Then
  jC = C.Column
  Tmp = Sheet2.Range("A2").Value
  For Each Rng In Range("A2", Range("A2").End(xlDown)).Offset(, jC - 1)
    If InStr(Tmp, Rng.Offset(, 2 - jC).Value) Then Col = 0 Else Col = 1
    If Len(Rng) <> 8 - Col Then
      Rng.Interior.ColorIndex = 6
    Else
      If Left(Rng, 1) = "3" Then DauSo = Left(Rng, 2) Else DauSo = Left(Rng, 3)
      Set C = Sheet2.Range("A3:A33").Offset(, Col).Find(DauSo, , xlValues, xlWhole)
      If C Is Nothing Then Rng.Interior.ColorIndex = 4
    End If
  Next
End If
End Sub
 
Upvote 0
"Dien thoai ban" là không dấu, nằm tại dòng 1
Thêm đoạn màu xanh, sửa đoạn màu nâu.
Chém đại vài dòng, sai đâu sửa đấy.
Mã:
.....
Tem = Sheet2.Range("A2").Value
[COLOR=#008080][B]Dim Col[/B]
[B]For Each Cll In Range("A1", Range("A1").End(xlToRight))[/B]
[B]If Cll = "Dien thoai ban" Then Col = Cll.Column[/B]
[B]Next Cll
[/B][/COLOR][COLOR=#a52a2a][B]For Each Cll In Range("A2", Range("A2").End(xlDown)).Offset(, Col - 1)[/B][/COLOR]
DK = False
.....
Chào Anh,

Em đã sửa lại đoạn code khi thây đổi vị trị cột so dien thoai bàn lại bị báo lỗi.. em xem giúp em nhé

Cảm ơn anh!
 

File đính kèm

Upvote 0
Mã:
Sub GPE()
Dim Rng As Range, C As Range, jC As Long, Col As Long, DauSo As String, Tmp As String, DK As Boolean
Tmp = "Dien thoai ban"
Set C = Sheet1.Range("A1:AX1").Find(Tmp, , xlValues, xlPart)
If Not C Is Nothing Then
  jC = C.Column
  Tmp = Sheet2.Range("A2").Value
  For Each Rng In Range("A2", Range("A2").End(xlDown)).Offset(, jC - 1)
    If InStr(Tmp, Rng.Offset(, 2 - jC).Value) Then Col = 0 Else Col = 1
    If Len(Rng) <> 8 - Col Then
      Rng.Interior.ColorIndex = 6
    Else
      If Left(Rng, 1) = "3" Then DauSo = Left(Rng, 2) Else DauSo = Left(Rng, 3)
      Set C = Sheet2.Range("A3:A33").Offset(, Col).Find(DauSo, , xlValues, xlWhole)
      If C Is Nothing Then Rng.Interior.ColorIndex = 4
    End If
  Next
End If
End Sub

Code này hay và chạy tốt ạ... cảm ơn anh đã giúp đỡ em nhé....
 
Upvote 0
Chào Anh,

Em đã sửa lại đoạn code khi thây đổi vị trị cột so dien thoai bàn lại bị báo lỗi.. em xem giúp em nhé

Cảm ơn anh!
Sửa cái này
Mã:
For Each Cll In Range("A1", Range("A1").End(xlToRight))
Ra cái này là ok
Mã:
For Each Cll In Range("A1", Range("XFD1").End(xlToLeft))
Bảng dữ liệu gì mà dòng tiêu đề từa lưa hột dưa vậy bạn
 
Upvote 0
Sửa cái này
Mã:
For Each Cll In Range("A1", Range("A1").End(xlToRight))
Ra cái này là ok
Mã:
For Each Cll In Range("A1", Range("XFD1").End(xlToLeft))
Bảng dữ liệu gì mà dòng tiêu đề từa lưa hột dưa vậy bạn

Chào Thầy! lúc em di chuyển vị trí của cột So Dien Thoai Ban thì đoạn code trên không lấy được giá trị của cột Tinh/Thanh Pho nên dẫn đến tình trạng sai nhiều.. Thầy có cách nào giúp em không ạ...
Cảm ơn Thầy
 
Upvote 0
Mã:
Sub GPE()
Dim Rng As Range, C As Range, jC As Long, Col As Long, DauSo As String, Tmp As String, DK As Boolean
Tmp = "Dien thoai ban"
Set C = Sheet1.Range("A1:AX1").Find(Tmp, , xlValues, xlPart)
If Not C Is Nothing Then
  jC = C.Column
  Tmp = Sheet2.Range("A2").Value
  For Each Rng In Range("A2", Range("A2").End(xlDown)).Offset(, jC - 1)
    If InStr(Tmp, Rng.Offset(, 2 - jC).Value) Then Col = 0 Else Col = 1
    If Len(Rng) <> 8 - Col Then
      Rng.Interior.ColorIndex = 6
    Else
      If Left(Rng, 1) = "3" Then DauSo = Left(Rng, 2) Else DauSo = Left(Rng, 3)
      Set C = Sheet2.Range("A3:A33").Offset(, Col).Find(DauSo, , xlValues, xlWhole)
      If C Is Nothing Then Rng.Interior.ColorIndex = 4
    End If
  Next
End If
End Sub

Chào Thầy! lúc em di chuyển vị trí của cột So Dien Thoai Ban thì đoạn code trên không lấy được giá trị của cột Tinh/Thanh Pho nên dẫn đến tình trạng sai nhiều.. Thầy có cách nào giúp em không ạ...
Cảm ơn Thầy
 
Upvote 0
Chào Thầy! lúc em di chuyển vị trí của cột So Dien Thoai Ban thì đoạn code trên không lấy được giá trị của cột Tinh/Thanh Pho nên dẫn đến tình trạng sai nhiều.. Thầy có cách nào giúp em không ạ...
Cảm ơn Thầy
bạn có di chuyển cột tỉnh thành không? code viết cho cột tỉnh thành là cột B
 
Upvote 0
...
Dạ 02 cột Tỉnh/Thanh và Dien Thoai Ban đều không cố định ạ... nếu như vậy thì sửa code được không ạ?...
Gợi ý :
Bạn chỉ cần nói rõ tất cả các tiêu đề cột của sheet dữ liệu là được, bạn thích đặt nằm đâu trong sheet cũng được, code sẽ tự tìm. Nhưng chắc chắn phải là tất cả các tiêu đề cột nghe bạn hiền.
Làm vậy thì chắc 1 phát là xong. hehe

Gơi ý thế thôi chứ chắc tầm tui không có code được, phải chờ cao thủ ra tay thôi.
Mà nếu làm được thế thì bố cục dữ liệu cũng nhàn, thoải mái
 
Upvote 0
Chào Thầy!

Dạ 02 cột Tỉnh/Thanh và Dien Thoai Ban đều không cố định ạ... nếu như vậy thì sửa code được không ạ?

Cảm ơn Thầy.!
dùng code
Mã:
Sub GPE()
Dim Rng As Range, C As Range, dtC As Long, ttC As Long, Col As Long, DauSo As String, Tmp As String
Tmp = "Dien thoai ban"
Set C = Sheet1.Range("A1:AX1").Find(Tmp, , xlValues, xlPart)
If Not C Is Nothing Then
  dtC = C.Column
  Tmp = "Tinh/Thanh Pho"
  Set C = Sheet1.Range("A1:AX1").Find(Tmp, , xlValues, xlPart)
  If Not C Is Nothing Then
    ttC = C.Column
    Tmp = Sheet2.Range("A2").Value
    For Each Rng In Range("A2", Range("A2").End(xlDown)).Offset(, dtC - 1)
      If InStr(Tmp, Rng.Offset(, ttC - dtC).Value) Then Col = 0 Else Col = 1
      If Len(Rng) <> 8 - Col Then
        Rng.Interior.ColorIndex = 6
      Else
        If Left(Rng, 1) = "3" Then DauSo = Left(Rng, 2) Else DauSo = Left(Rng, 3)
        Set C = Sheet2.Range("A3:A33").Offset(, Col).Find(DauSo, , xlValues, xlWhole)
        If C Is Nothing Then Rng.Interior.ColorIndex = 4
      End If
    Next
  End If
End If
End Sub
 
Upvote 0
dùng code
Mã:
Sub GPE()
Dim Rng As Range, C As Range, dtC As Long, ttC As Long, Col As Long, DauSo As String, Tmp As String
Tmp = "Dien thoai ban"
Set C = Sheet1.Range("A1:AX1").Find(Tmp, , xlValues, xlPart)
If Not C Is Nothing Then
  dtC = C.Column
  Tmp = "Tinh/Thanh Pho"
  Set C = Sheet1.Range("A1:AX1").Find(Tmp, , xlValues, xlPart)
  If Not C Is Nothing Then
    ttC = C.Column
    Tmp = Sheet2.Range("A2").Value
    For Each Rng In Range("A2", Range("A2").End(xlDown)).Offset(, dtC - 1)
      If InStr(Tmp, Rng.Offset(, ttC - dtC).Value) Then Col = 0 Else Col = 1
      If Len(Rng) <> 8 - Col Then
        Rng.Interior.ColorIndex = 6
      Else
        If Left(Rng, 1) = "3" Then DauSo = Left(Rng, 2) Else DauSo = Left(Rng, 3)
        Set C = Sheet2.Range("A3:A33").Offset(, Col).Find(DauSo, , xlValues, xlWhole)
        If C Is Nothing Then Rng.Interior.ColorIndex = 4
      End If
    Next
  End If
End If
End Sub

Chào Thầy!

Nhờ Thầy em đã giải quyết được vấn đề của mình rồi ạ... Em cảm ơn Thầy nhé...! /-*+/
 
Upvote 0
Gợi ý :
Bạn chỉ cần nói rõ tất cả các tiêu đề cột của sheet dữ liệu là được, bạn thích đặt nằm đâu trong sheet cũng được, code sẽ tự tìm. Nhưng chắc chắn phải là tất cả các tiêu đề cột nghe bạn hiền.
Làm vậy thì chắc 1 phát là xong. hehe

Gơi ý thế thôi chứ chắc tầm tui không có code được, phải chờ cao thủ ra tay thôi.
Mà nếu làm được thế thì bố cục dữ liệu cũng nhàn, thoải mái

Chào bạn!
Cảm ơn bạn đã quan tâm đến bài viết của mình và nêu gợi ý rất hay ạ...
File đính kèm bên dưới là data thực tế mình đang làm, do file có nhiều cột nên mình đã xoá bớt để lại những cột cần thiết thôi ạ... Nhờ các Thầy GPE mà mình đã gôm được tất cả các Macro cần thiết cho công việc của mình... (Mình có higline vàng các cột mình cần Check) có cách nào gôm các Macro thành một không ạ và bạn có ý tưởng gì góp ý cho mình nhé...

Cảm ơn bạn hiền ..! Thân chào..
 

File đính kèm

Upvote 0
Chào bạn!
Cảm ơn bạn đã quan tâm đến bài viết của mình và nêu gợi ý rất hay ạ...
File đính kèm bên dưới là data thực tế mình đang làm, do file có nhiều cột nên mình đã xoá bớt để lại những cột cần thiết thôi ạ... Nhờ các Thầy GPE mà mình đã gôm được tất cả các Macro cần thiết cho công việc của mình... (Mình có higline vàng các cột mình cần Check) có cách nào gôm các Macro thành một không ạ và bạn có ý tưởng gì góp ý cho mình nhé...

Cảm ơn bạn hiền ..! Thân chào..
Nhiều cột hay ít cột chẳng quan trọng. Quan trọng là cấu trúc file gửi lên diễn đàn có giống file thật hay không. Bài trước bạn gửi file giả định có các cột tách rời hẳn nhau đâu có giống file của bài này -> code trước lỗi là chuyện đương nhiên.

File bạn gửi lên bố cục trước sau không thống nhất:
thứ 1 là không tôn trọng người viết code hỗ trợ vì đưa file không thật làm người viết code mất công làm lại
thứ 2 Nhìn vào cấu trúc file trước, các cột bố trí vô tội vạ mà cũng gửi lên, hóa ra bạn đùa chăng.

Bài của bạn đâu có gì mà phức tạp, phức tạp là do bạn không đủ trình nhìn nhận hết vấn đề để mà nêu ra cho mọi người giúp đỡ dẫn đến sửa đi sửa lại. Bài trước tôi nhìn thấy vậy nên cũng chẳng muốn mất công làm gì.

Với ý tưởng của bạn, có lẽ còn lâu mới giải quyết được rốt ráo cái file này. Bôi màu cũng chỉ hại mắt chứ có hỗ trợ tính toán được gì đâu.

Vài lời nói thẳng.
Chúc bạn dùng tốt hàng của mình.
 
Upvote 0
Nhiều cột hay ít cột chẳng quan trọng. Quan trọng là cấu trúc file gửi lên diễn đàn có giống file thật hay không. Bài trước bạn gửi file giả định có các cột tách rời hẳn nhau đâu có giống file của bài này -> code trước lỗi là chuyện đương nhiên.

File bạn gửi lên bố cục trước sau không thống nhất:
thứ 1 là không tôn trọng người viết code hỗ trợ vì đưa file không thật làm người viết code mất công làm lại
thứ 2 Nhìn vào cấu trúc file trước, các cột bố trí vô tội vạ mà cũng gửi lên, hóa ra bạn đùa chăng.

Bài của bạn đâu có gì mà phức tạp, phức tạp là do bạn không đủ trình nhìn nhận hết vấn đề để mà nêu ra cho mọi người giúp đỡ dẫn đến sửa đi sửa lại. Bài trước tôi nhìn thấy vậy nên cũng chẳng muốn mất công làm gì.

Với ý tưởng của bạn, có lẽ còn lâu mới giải quyết được rốt ráo cái file này. Bôi màu cũng chỉ hại mắt chứ có hỗ trợ tính toán được gì đâu.

Vài lời nói thẳng.
Chúc bạn dùng tốt hàng của mình.

Cảm ơn bạn vì những lời góp ý trên...

mình xin lỗi vì để bạn hiểu nhầm là mình không tôn trọng người viết code.. mình chỉ nghỉ là muốn đơn giản các cột lại cho các Thầy dễ hiểu ý của mình thôi...

Thành thật xin lỗi...(@$%@(@$%@
 
Upvote 0
Web KT

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

Back
Top Bottom