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

Elx Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
R

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

Sắp xếp theo thời gian sắp xếp theo bầu chọn
Bạn xem đúng ý bạn chưa.
 

File đính kèm

Upvote 0
Bạn quét chọn vùng I2:I2605, mở thẻ Home --> Conditional formatting --> Manage Rules.. nháy chọn vào công thức và nháy nút Edit Rule... để xem tôi đã làm gì.
 
Upvote 0
Vậy dùng thử code này xem sao.
Mã: 
Sub GPE()
Dim sCell As Range
For Each sCell In Sheet1.Range("I2", Sheet1.Range("I65000").End(xlUp))
    If Application.WorksheetFunction.CountIf(Sheet2.[a3:b23], Left(sCell.FormulaR1C1, Len(sCell.FormulaR1C1) - 7)) = 0 Then sCell.Interior.Color = 65535
Next sCell
End Sub
 
Upvote 0
giaiphap đã viết:
Vậy dùng thử code này xem sao.
Mã: 
Sub GPE()
Dim sCell As Range
For Each sCell In Sheet1.Range("I2", Sheet1.Range("I65000").End(xlUp))
    If Application.WorksheetFunction.CountIf(Sheet2.[a3:b23], Left(sCell.FormulaR1C1, Len(sCell.FormulaR1C1) - 7)) = 0 Then sCell.Interior.Color = 65535
Next sCell
End Sub
Nhấp chuột vào đây để mở rộng...

Em cảm ơn Thầy ạ, Code đã chạy đúng rồi ạ... còn một câu nữa cho em hỏi ạ...
Do Teamplate (tức cột của số điện thoại thường không cố định), em muốn code của mình khi chạy sẽ tìm đến cột có tên là HandPhone và làm việc tại đó, thì mình thây đổi sao ạ...

Mong Thầy giúp đỡ..
 
Upvote 0
robinhsoon đã viết:
Em cảm ơn Thầy ạ, Code đã chạy đúng rồi ạ... còn một câu nữa cho em hỏi ạ...
Do Teamplate (tức cột của số điện thoại thường không cố định), em muốn code của mình khi chạy sẽ tìm đến cột có tên là HandPhone và làm việc tại đó, thì mình thây đổi sao ạ...

Mong Thầy giúp đỡ..
Nhấp chuột vào đây để mở rộng...
Code đã chạy đúng rồi ạ
Nhấp chuột vào đây để mở rộng...
Hình như.........có gì chưa đúng lắm
Dòng 216 em này bị tô vàng 0996874897
Dòng 570 em này ....cũng bị tô vàng 0994776159
code của mình khi chạy sẽ tìm đến cột có tên là HandPhone
Nhấp chuột vào đây để mở rộng...
Tìm cột có chứa nội dung "HandPhone" trong hàng đầu của vùng dữ liệu ở sheet "Data"
Híc
Thân
 
Upvote 0

concogia đã viết:
Dòng 216 em này bị tô vàng 0996874897
Dòng 570 em này ....cũng bị tô vàng 0994776159

Tìm cột có chứa nội dung "HandPhone" trong hàng đầu của vùng dữ liệu ở sheet "Data"
Híc
Thân
Nhấp chuột vào đây để mở rộng...

Nó chỉ có 10 số thôi bác.
robinhsoon đã viết:
Em cảm ơn Thầy ạ, Code đã chạy đúng rồi ạ... còn một câu nữa cho em hỏi ạ...
Do Teamplate (tức cột của số điện thoại thường không cố định), em muốn code của mình khi chạy sẽ tìm đến cột có tên là HandPhone và làm việc tại đó, thì mình thây đổi sao ạ...

Mong Thầy giúp đỡ..
Nhấp chuột vào đây để mở rộng...
Vậy sửa lại lần nửa nhé.
Mã: 
Sub GPE()
Dim sCell As Range, cSeach As Range
Set cSeach = Sheet1.Cells.Find("Handphone")
If Not cSeach Is Nothing Then
    For Each sCell In Sheet1.Range(cSeach.Offset(1).Address, Sheet1.Range(cSeach.Offset(65000).Address).End(xlUp))
        If Application.WorksheetFunction.CountIf(Sheet2.[a3:b23], Left(sCell.FormulaR1C1, Len(sCell.FormulaR1C1) - 7)) = 0 Then sCell.Interior.Color = 65535
    Next sCell
Else
    MsgBox "xin loi khong tim thay cot Handphone"
End If
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
@robinhsoon
Hình như code này từa tựa hay hao hao giống trong CF. Thích code thì là có ngay nhưng bài phải khó hơn nữa kìa.
 
Upvote 0
giaiphap đã viết:


Nó chỉ có 10 số thôi bác.

Vậy sửa lại lần nửa nhé.
Mã: 
Sub GPE()
Dim sCell As Range, cSeach As Range
Set cSeach = Sheet1.Cells.Find("Handphone")
If Not cSeach Is Nothing Then
    For Each sCell In Sheet1.Range(cSeach.Offset(1).Address, Sheet1.Range(cSeach.Offset(65000).Address).End(xlUp))
        If Application.WorksheetFunction.CountIf(Sheet2.[a3:b23], Left(sCell.FormulaR1C1, Len(sCell.FormulaR1C1) - 7)) = 0 Then sCell.Interior.Color = 65535
    Next sCell
Else
    MsgBox "xin loi khong tim thay cot Handphone"
End If
End Sub
Nhấp chuột vào đây để mở rộng...

Chào Thầy!

Vừa may em cũng gặp một bài toán giống như vậy nhưng là kiểm tra số điện thoại bàn, Thầy giúp em nhé.

Em có một File Data gồm các cột 1. [Mã Cửa Tiệm] 2.[Tỉnh/Thành Phố] và 3.[cột số điện thoại bàn]

1. Tại cột số điện thoại bàn em muốn kiểm tra chiều dài các số điện thoại, Nếu chiều dài là 7 hoặc 8 là đúng, còn những trường hợp khác là sai sẽ higline vàng lên
2. So sánh những số điện thoại có chiều dài 8 thì tường ứng với 03 Thành Phố (HCM,HN,HT) và kiểm tra lần lượt các đầu số đã khai báo ở [Sheet Phone] và cột A
3. So sánh những số điện thoại có chiều dài 7 thì tường ứng với Các Tỉnh còn lại và kiểm tra lần lượt các đầu số đã khai báo ở [Sheet Phone] và cột B

Hơi rắc rối một tí, nhưng mong Thầy giúp đỡ...
Cảm ơn Thầy...
 

File đính kèm

Upvote 0
giaiphap đã viết:


Nó chỉ có 10 số thôi bác.

Vậy sửa lại lần nửa nhé.
Mã: 
Sub GPE()
Dim sCell As Range, cSeach As Range
Set cSeach = Sheet1.Cells.Find("Handphone")
If Not cSeach Is Nothing Then
    For Each sCell In Sheet1.Range(cSeach.Offset(1).Address, Sheet1.Range(cSeach.Offset(65000).Address).End(xlUp))
        If Application.WorksheetFunction.CountIf(Sheet2.[a3:b23], Left(sCell.FormulaR1C1, Len(sCell.FormulaR1C1) - 7)) = 0 Then sCell.Interior.Color = 65535
    Next sCell
Else
    MsgBox "xin loi khong tim thay cot Handphone"
End If
End Sub
Nhấp chuột vào đây để mở rộng...

Em Cảm Ơn Thầy đã giúp em, em đã làm được rồi ạ...

Chúc Thầy sức khỏe và Thành Công ạ
 
Upvote 0
nguyetnga1992 đã viết:
Chào Thầy!

Vừa may em cũng gặp một bài toán giống như vậy nhưng là kiểm tra số điện thoại bàn, Thầy giúp em nhé.

Em có một File Data gồm các cột 1. [Mã Cửa Tiệm] 2.[Tỉnh/Thành Phố] và 3.[cột số điện thoại bàn]

1. Tại cột số điện thoại bàn em muốn kiểm tra chiều dài các số điện thoại, Nếu chiều dài là 7 hoặc 8 là đúng, còn những trường hợp khác là sai sẽ higline vàng lên
2. So sánh những số điện thoại có chiều dài 8 thì tường ứng với 03 Thành Phố (HCM,HN,HT) và kiểm tra lần lượt các đầu số đã khai báo ở [Sheet Phone] và cột A
3. So sánh những số điện thoại có chiều dài 7 thì tường ứng với Các Tỉnh còn lại và kiểm tra lần lượt các đầu số đã khai báo ở [Sheet Phone] và cột B

Hơi rắc rối một tí, nhưng mong Thầy giúp đỡ...
Cảm ơn Thầy...
Nhấp chuột vào đây để mở rộng...
Bạn sử dụng đoạn code dưới đây thử xem, tôi thấy có điều gì đó bất ổn với dữ liệu của bạn.
Mã: 
Sub GPE()
Dim sCell As Range
Sheet1.Range("C2", Sheet1.Range("C65000").End(xlUp)).Interior.Pattern = xlNone
For Each sCell In Sheet1.Range("C2", Sheet1.Range("C65000").End(xlUp))
    If Len(sCell.FormulaR1C1) = 7 Or Len(sCell.FormulaR1C1) = 8 Then
        If Len(sCell.FormulaR1C1) = 8 Then
            If Application.WorksheetFunction.CountIf(Sheet2.[a3:a33], Left(sCell.FormulaR1C1, Len(sCell.FormulaR1C1) - 5)) + _
            Application.WorksheetFunction.CountIf(Sheet2.[a3:a33], Left(sCell.FormulaR1C1, Len(sCell.FormulaR1C1) - 6)) = 0 Then sCell.Interior.Color = 65535
        ElseIf Len(sCell.FormulaR1C1) = 7 Then
            If Application.WorksheetFunction.CountIf(Sheet2.[b3:b33], Left(sCell.FormulaR1C1, Len(sCell.FormulaR1C1) - 5)) + _
            Application.WorksheetFunction.CountIf(Sheet2.[b3:b33], Left(sCell.FormulaR1C1, Len(sCell.FormulaR1C1) - 4)) = 0 Then sCell.Interior.Color = 65535


        End If
    Else
        sCell.Interior.Color = 65535
    End If
Next sCell
End Sub
 
Upvote 0
robinhsoon đã viết:
Em Cảm Ơn Thầy đã giúp em, em đã làm được rồi ạ...

Chúc Thầy sức khỏe và Thành Công ạ
Nhấp chuột vào đây để mở rộng...
Bạn sửa lại code thêm phần chổ màu đỏ nửa sẽ hay hơn.
Mã: 
Sub GPE()
Dim sCell As Range, cSeach As Range
Set cSeach = Sheet1.Cells.Find("Handphone")
[COLOR=#ff0000][B]Sheet1.Range(cSeach.Offset(1).Address, Sheet1.Range(cSeach.Offset(65000).Address).End(xlUp)).Interior.Pattern = xlNone[/B][/COLOR]
If Not cSeach Is Nothing Then
    For Each sCell In Sheet1.Range(cSeach.Offset(1).Address, Sheet1.Range(cSeach.Offset(65000).Address).End(xlUp))
       [COLOR=#ff0000][B] if Len(sCell.FormulaR1C1) = 10 Or Len(sCell.FormulaR1C1) = 11 then[/B][/COLOR]
               If Application.WorksheetFunction.CountIf(Sheet2.[a3:b23], Left(sCell.FormulaR1C1, Len(sCell.FormulaR1C1) - 7)) = 0 Then sCell.Interior.Color = 65535
         [COLOR=#ff0000][B]Else
               sCell.Interior.Color = 65535
         End If[/B][/COLOR]
    Next sCell
Else
    MsgBox "xin loi khong tim thay cot Handphone"
End If
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
giaiphap đã viết:
Bạn sử dụng đoạn code dưới đây thử xem, tôi thấy có điều gì đó bất ổn với dữ liệu của bạn.
Mã: 
Sub GPE()
Dim sCell As Range
Sheet1.Range("C2", Sheet1.Range("C65000").End(xlUp)).Interior.Pattern = xlNone
For Each sCell In Sheet1.Range("C2", Sheet1.Range("C65000").End(xlUp))
    If Len(sCell.FormulaR1C1) = 7 Or Len(sCell.FormulaR1C1) = 8 Then
        If Len(sCell.FormulaR1C1) = 8 Then
            If Application.WorksheetFunction.CountIf(Sheet2.[a3:a33], Left(sCell.FormulaR1C1, Len(sCell.FormulaR1C1) - 5)) + _
            Application.WorksheetFunction.CountIf(Sheet2.[a3:a33], Left(sCell.FormulaR1C1, Len(sCell.FormulaR1C1) - 6)) = 0 Then sCell.Interior.Color = 65535
        ElseIf Len(sCell.FormulaR1C1) = 7 Then
            If Application.WorksheetFunction.CountIf(Sheet2.[b3:b33], Left(sCell.FormulaR1C1, Len(sCell.FormulaR1C1) - 5)) + _
            Application.WorksheetFunction.CountIf(Sheet2.[b3:b33], Left(sCell.FormulaR1C1, Len(sCell.FormulaR1C1) - 4)) = 0 Then sCell.Interior.Color = 65535


        End If
    Else
        sCell.Interior.Color = 65535
    End If
Next sCell
End Sub
Nhấp chuột vào đây để mở rộng...

Đoạn code rất hay ạ.. Nhưng lúc em kiểm tra lai thì trong tổng số store trên có 02 store bị sai nhưng không highline vàng lên (em có note và higline đỏ lên)... thầy kiểm tra giúp em nhé...
Em cảm ơn Thầy..! Mong thầy giúp đỡ..
 

File đính kèm

Upvote 0
nguyetnga1992 đã viết:
Đoạn code rất hay ạ.. Nhưng lúc em kiểm tra lai thì trong tổng số store trên có 02 store bị sai nhưng không highline vàng lên (em có note và higline đỏ lên)... thầy kiểm tra giúp em nhé...
Em cảm ơn Thầy..! Mong thầy giúp đỡ..
Nhấp chuột vào đây để mở rộng...

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
 
Upvote 0
Ba Tê đã viết:
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
Nhấp chuột vào đây để mở rộng...

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
Ba Tê đã viết:
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
Nhấp chuột vào đây để mở rộng...
Bài này chơi....một vòng lặp được hông ???
Thân
 
Upvote 0
nguyetnga1992 đã viết:
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 đỡ ạ..
Nhấp chuột vào đây để mở rộng...

Mong Thầy giúp đỡ ạ..
 
Upvote 0
Ba Tê đã viết:
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
Nhấp chuột vào đây để mở rộng...

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
nguyetnga1992 đã viết:
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 ạ
Nhấp chuột vào đây để mở rộng...
"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
nguyetnga1992 đã viết:
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 ạ
Nhấp chuột vào đây để mở rộng...
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
TheThienChu đã viết:
"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
.....
Nhấp chuột vào đây để mở rộng...
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
HieuCD đã viết:
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
Nhấp chuột vào đây để mở rộng...

Code này hay và chạy tốt ạ... cảm ơn anh đã giúp đỡ em nhé....
 
Upvote 0
nguyetnga1992 đã viết:
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!
Nhấp chuột vào đây để mở rộng...
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
TheThienChu đã viết:
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
Nhấp chuột vào đây để mở rộng...

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
HieuCD đã viết:
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
Nhấp chuột vào đây để mở rộng...

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
nguyetnga1992 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
nguyetnga1992 đã viết:
...
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 ạ?...
Nhấp chuột vào đây để mở rộ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
nguyetnga1992 đã viết:
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.!
Nhấp chuột vào đây để mở rộng...
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
HieuCD đã viết:
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
Nhấp chuột vào đây để mở rộng...

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
TheThienChu đã viết:
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
Nhấp chuột vào đây để mở rộng...

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
nguyetnga1992 đã viết:
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..
Nhấp chuột vào đây để mở rộng...
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
TheThienChu đã viết:
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.
Nhấp chuột vào đây để mở rộng...

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
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

P
Hyperlink_Cách chuyển cả thư mục và file tổng hợp sang máy khác không bị lỗi (1 người xem)
Trả lời
2
Đọc
34
phong_kid
P
HeSanbi
Tiện ích Web: Tự động nhấn nút "Bỏ qua" quảng cáo Youtube (2 người xem)
    • Thích
    • Yêu thích
Trả lời
14
Đọc
1K
ongke0711
ongke0711
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
55
Đọc
22K
Gà Con yêu VBA
Gà Con yêu VBA
C
Fix lỗi Application.InputBox Type:=8 (2 người xem)
    • Cười
Trả lời
20
Đọc
539
cdshtz88
C
ptm0412
Quá tin tưởng vào AI các thể loại (2 người xem)
    • Cười
Trả lời
4
Đọc
142
Maika8008
Maika8008
A
  • Question Question
Không tìm được lỗi code (1 người xem)
Trả lời
6
Đọc
92
ptm0412
ptm0412
SA_DQ
Copilot bình luận về một ván cờ vua
    • Thích
Trả lời
5
Đọc
370
SA_DQ
SA_DQ
W
Tham chiếu theo chuỗi ký tự (1 người xem)
Trả lời
8
Đọc
285
dungpham01
D
tritv.dad
Lấy dữ liệu từ folder các tờ khai thông quan để theo dõi hiệu suất công việc.
Trả lời
8
Đọc
253
BlueSphere
B
GPE-Trợ Lý
MỪNG NGÀY NHÀ GIÁO VIỆT NAM 20/11 (2 người xem)
    • Thích
Trả lời
0
Đọc
724
GPE-Trợ Lý
GPE-Trợ Lý
SA_DQ
Xin chúc mừng các thầy cô giáo trên cộng đồng nhân 20/11
    • Thích
    • Yêu thích
Trả lời
1
Đọc
108
BuiQuangThuan
B
M
chuyển đổi số thành chữ
Trả lời
15
Đọc
291
dungpham01
D
V
Lỗi copy sheet: the name already exists. (1 người xem)
Trả lời
7
Đọc
678
nghiabros
N
L
Nhờ hỗ trợ tìm hàm excel trả về giá trị
Trả lời
4
Đọc
118
lechuong174
L
SA_DQ
Copilot & giúp hỗ trợ nhập các ký tự đặt biệt
    • Thích
Trả lời
0
Đọc
80
SA_DQ
SA_DQ
GPE-Trợ Lý
[GPE20] BIỂU ĐỒ CHUYÊN NGHIỆP: PHÁ VỠ GIỚI HẠN 2 TRỤC CỦA EXCEL
    • Thích
    • Yêu thích
Trả lời
1
Đọc
4K
GPE-Trợ Lý
GPE-Trợ Lý
hadu8889
EXCEL TỰ ĐỘNG ĐÓNG KHI SỬA TEXT Ở TRÊN USERFORM
Trả lời
10
Đọc
250
LOGANWover
L
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (3 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
4 5 6
Trả lời
565
Đọc
78K
lacmatquan
L
H
Lấy giá trị format trong ô của excel
Trả lời
2
Đọc
171
LOGANWover
L
A
Tìm nơi học VBA uy tín (1 người xem)
    • Cười
Trả lời
2
Đọc
160
SA_DQ
SA_DQ
Xem thêm…

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom