Giúp em code tìm giá trị header bị trùng và xóa cột

[nhnn1986]

Chào Anh/Chị ạ

Em muốn tìm giá trị Header bị trùng tại dòng 3 từ D4 đến Di, i là cột cuối dao động từ 50 đến 189. Nếu giá trị trùng nhau thì sẽ xóa cột bị trùng (có thể trùng 2,3 hoặc 4 lần)
Em dùng code như bên dưới nhưng chạy thì nó xóa sạch luôn các cột từ D4i

Mong Anh/Chị xem thử code có bị lỗi gì không ạ, em cảm ơn.

Sub check_header()
Dim lcol As Long, xCol As Long, thisCol As Long, wS As Worksheet
Set wS = ThisWorkbook.Sheets("result")
Application.ScreenUpdating = False
    With wS
        xCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
        If xCol < 4 Then Exit Sub
        For thisCol = xCol To 4 Step -1
            If Application.Match(.Cells(3, thisCol).Value, .Range(.Cells(3, 4), .Cells(3, xCol)), 0) <> thisCol Then
                .Cells(3, thisCol).EntireColumn.Delete xlShiftToLeft
            End If
        Next thisCol
    End With
Application.ScreenUpdating = True
End Sub

 

[snow25]

Chào Anh/Chị ạ

Em muốn tìm giá trị Header bị trùng tại dòng 3 từ D4 đến Di, i là cột cuối dao động từ 50 đến 189. Nếu giá trị trùng nhau thì sẽ xóa cột bị trùng (có thể trùng 2,3 hoặc 4 lần)
Em dùng code như bên dưới nhưng chạy thì nó xóa sạch luôn các cột từ D4i

Mong Anh/Chị xem thử code có bị lỗi gì không ạ, em cảm ơn.

Sub check_header()
Dim lcol As Long, xCol As Long, thisCol As Long, wS As Worksheet
Set wS = ThisWorkbook.Sheets("result")
Application.ScreenUpdating = False
    With wS
        xCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
        If xCol < 4 Then Exit Sub
        For thisCol = xCol To 4 Step -1
            If Application.Match(.Cells(3, thisCol).Value, .Range(.Cells(3, 4), .Cells(3, xCol)), 0) <> thisCol Then
                .Cells(3, thisCol).EntireColumn.Delete xlShiftToLeft
            End If
        Next thisCol
    End With
Application.ScreenUpdating = True
End Sub

Thử cái này.Mình không thích dùng công thức lắm nên chỉnh 1 chút.

Sub check_header()
Dim lcol As Long, xCol As Long, thisCol As Long, wS As Worksheet, dic As Object, dk As String
Set dic = CreateObject("scripting.dictionary")
Set wS = ThisWorkbook.Sheets("result")
Application.ScreenUpdating = False
    With wS
        xCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
        If xCol < 4 Then Exit Sub
        For thisCol = xCol To 4 Step -1
            dk = .Cells(3, thisCol).Value
            If Not dic.exists(dk) Then
               dic.Add dk, ""
            Else
               .Cells(3, thisCol).EntireColumn.Delete xlShiftToLeft
            End If
        Next thisCol
    End With
Application.ScreenUpdating = True
End Sub

 

[VetMini]

Trong đoạn code này:

        For thisCol = xCol To 4 Step -1
            If Application.Match(.Cells(3, thisCol).Value, .Range(.Cells(3, 4), .Cells(3, xCol)), 0) <> thisCol Then
                .Cells(3, thisCol).EntireColumn.Delete xlShiftToLeft
            End If
        Next thisCol

Thì ở dòng
If Application.Match(.Cells(3, thisCol).Value, .Range(.Cells(3, 4), .Cells(3, xCol)), 0) <> thisCol Then
bạn thực hiện lô gic so sánh sai
1. Nếu không tìm thấy thì Match trả về Error, tức là <> thisCol
2. Nếu tìm thấy thì Match trả về vị trí match - 4 + 1, tức là cungx <> thisCol
Cả hai trường hợp đều dẫn đến xoá cột.

Cách sửa: Muốn biết Match có tìm được hay không thì bạn phải dùng hàm IsNumeric để thử kết quả trả về của nó.

 

[snow25]

Trong đoạn code này:

Thì ở dòng
If Application.Match(.Cells(3, thisCol).Value, .Range(.Cells(3, 4), .Cells(3, xCol)), 0) <> thisCol Then
bạn thực hiện lô gic so sánh sai
1. Nếu không tìm thấy thì Match trả về Error, tức là <> thisCol
2. Nếu tìm thấy thì Match trả về vị trí match - 4 + 1, tức là cungx <> thisCol
Cả hai trường hợp đều dẫn đến xoá cột.

Cách sửa: Muốn biết Match có tìm được hay không thì bạn phải dùng hàm IsNumeric để thử kết quả trả về của nó.

Em thấy đơn giản hơn là dùng hàm đếm countif là được.

 

[VetMini]

Em thấy đơn giản hơn là dùng hàm đếm countif là được.

Thớt hỏi sai ở đâu và tôi chỉ nêu ra điểm sai của thớt.

Sẵn đây đính chính bài #3:
Trong mảng để tìm ở trên, tôi không để ý là code của thớt có bao luôn cái ô cuối cùng chứa trị tìm kiếm. Vì vậy hàm match luôn luôn trả về là tìm được. Chỉ là vị trí tìm được bị lệch 3 ô cho nên luôn luôn <> thisCol (cái mảng để dò bắt đầu từ cột 4)

Vì vậy, thớt chỉ cần sửa:
If Application.Match(.Cells(3, thisCol).Value, .Range(.Cells(3, 4), .Cells(3, xCol)), 0) <> thisCol - 3 Then

 

[nhnn1986]

Em cảm ơn anh @snow25 và anh @VetMini ạ

Do code này có liên quan đến một số đoạn sau này nữa nên em xin được sửa theo đúng code #5 và thấy chạy đúng ý em rồi ạ hi hi

Em sẽ sử dụng đoạn code viết theo mảng tại #2 để học hỏi thêm. Nhân tiện anh @snow25 hướng dẫn em dùng countif được không ạ? Em đang học code nên biết nhiều phương pháp xíu càng tốt ạ

 

[snow25]

Em cảm ơn anh @snow25 và anh @VetMini ạ

Do code này có liên quan đến một số đoạn sau này nữa nên em xin được sửa theo đúng code #5 và thấy chạy đúng ý em rồi ạ hi hi

Em sẽ sử dụng đoạn code viết theo mảng tại #2 để học hỏi thêm. Nhân tiện anh @snow25 hướng dẫn em dùng countif được không ạ? Em đang học code nên biết nhiều phương pháp xíu càng tốt ạ

Bài 2 có dùng mảng đâu nhỉ.Bài 2 là dùng dictionary nhé bạn.Bạn dùng hàm countif kiểm tra xem nếu mà lớn hơn 1 thì xóa đi là xong à.