Xóa các tiêu đề lặp lại (1 người xem)

[vanvan9697]

Dạ em có 1 file dữ liệu gồm nhiều tiêu đề lặp lại. Em muốn dùng VBa xóa các tiêu đề phát sinh nhiều lần. Anh (chị) giúp đỡ em với ạ !

 

[PacificPR]

Dạ em có 1 file dữ liệu gồm nhiều tiêu đề lặp lại. Em muốn dùng VBa xóa các tiêu đề phát sinh nhiều lần. Anh (chị) giúp đỡ em với ạ !

Cái này dùng Filter với STT xóa 1 phát là xong cần gì VBA vậy Bạn

 

[vanvan9697]

Dạ em muốn Đoạn sub có thể xóa dòng với điều kiện chỉ cần đánh STT hoặc nhiều dòng có các từ khác chẳng hạn là nó xóa luôn ấy anh ạ.

 

[tam888]

Dạ em muốn Đoạn sub có thể xóa dòng với điều kiện chỉ cần đánh STT hoặc nhiều dòng có các từ khác chẳng hạn là nó xóa luôn ấy anh ạ.

Muốn là 1 chuyện có đáng làm không là chuyện khác, trong khi có công cụ tốt rồi - hãy chọn giải pháp nhanh và dễ hiểu

 

[vanvan9697]

Muốn là 1 chuyện có đáng làm không là chuyện khác, trong khi có công cụ tốt rồi - hãy chọn giải pháp nhanh và dễ hiểu

Dạ vâng. Em cảm ơn anh ạ !.

 

[snow25]

Dạ em có 1 file dữ liệu gồm nhiều tiêu đề lặp lại. Em muốn dùng VBa xóa các tiêu đề phát sinh nhiều lần. Anh (chị) giúp đỡ em với ạ !

Thêm điều kiện gì nữa đi làm cho nó bõ 1 cái code.Bạn xem code.

Sub xoatieude()
Dim arr, arr1
Dim a As Long, lr As Long, i As Long, j As Integer
With Sheet1
    lr = .Range("C" & Rows.Count).End(xlUp).Row
    If lr < 2 Then Exit Sub
    arr = .Range("b2:i" & lr).Value
    ReDim arr1(1 To UBound(arr, 1), 1 To UBound(arr, 2))
    For i = 1 To UBound(arr, 2)
       arr1(1, i) = arr(1, i)
    Next i
    a = 1
    For i = 2 To UBound(arr, 1)
        If UCase(arr(i, 1)) <> "STT" Then
           a = a + 1
           For j = 1 To UBound(arr, 2)
              arr1(a, j) = arr(i, j)
           Next j
       End If
    Next i
    lr = .Range("m" & Rows.Count).End(xlUp).Row
    .Range("M2:T" & lr).ClearContents
    .Range("M2").Resize(a, UBound(arr, 2)).Value = arr1
End With
End Sub

 

[phulien1902]

Dạ em có 1 file dữ liệu gồm nhiều tiêu đề lặp lại. Em muốn dùng VBa xóa các tiêu đề phát sinh nhiều lần. Anh (chị) giúp đỡ em với ạ !

Bạn thử:

Sub Copy_STT()
    Dim LR As Long
    Application.ScreenUpdating = False
    With Sheet1
        LR = .Range("B" & Rows.Count).End(xlUp).Row
        .Range("B2").AutoFilter 1, "<>STT"
        .Range("B3:I" & LR).SpecialCells(xlVisible).Copy Range("M3")
        .Range("B2").AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

 

[vanaccex]

Bạn thử đoạn sub này ngắn gọn xem. Nếu thêm nữa thì lại thêm điều kiện

Sub XoaTieuDe()
    Dim Dong As Long, k As Long
    With Sheet1
        Dong = .[B65000].End(3).Row
        For k = 3 To Dong
            If UCase(.Cells(k, 2)) Like "STT*" Then .Cells(k, 2).EntireRow.Delete
        Next
    End With
End Sub

 

[tam888]

Bạn thử đoạn sub này ngắn gọn xem. Nếu thêm nữa thì lại thêm điều kiện

Sub XoaTieuDe()
    Dim Dong As Long, k As Long
    With Sheet1
        Dong = .[B65000].End(3).Row
        For k = 3 To Dong
            If UCase(.Cells(k, 2)) Like "STT*" Then .Cells(k, 2).EntireRow.Delete
        Next
    End With
End Sub

Nếu dùng Range, hay Cells khi xóa dòng như thế thì nên dùng For ngược (Step=-1)
Nhưng bài này thì làm cho nó hài hước, cứu đói

 

[vanvan9697]

Dạ vâng em cảm ơn các anh (chị) đã giúp đỡ em !

 

[vanaccex]

Nếu dùng Range, hay Cells khi xóa dòng như thế thì nên dùng For ngược (Step=-1)
Nhưng bài này thì làm cho nó hài hước, cứu đói

Xóa được đúng cho nội dung anh ạ

 

[snow25]

Xóa được đúng cho nội dung anh ạ

Dữ liệu của bạn có 2 cái STT liên tiếp xem có đúng không.

 

[tam888]

Xóa được đúng cho nội dung anh ạ

Như snow25 nói trên, hãy thử kiểm tra, code của bạn chỉ đúng với số liệu ví dụ hiện thời

 

[vanaccex]

Như snow25 nói trên, hãy thử kiểm tra, code của bạn chỉ đúng với số liệu ví dụ hiện thời

Cái này đúng như anh Nói chạy 2 lần mới ok