Xóa các tiêu đề lặp lại

Liên hệ QC

vanvan9697

Thành viên chính thức
Tham gia
11/5/12
Bài viết
94
Được thích
5
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 ạ !
 

File đính kèm

  • Xoa cot co tieu de.xlsx
    10.2 KB · Đọc: 10
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 ạ.
 
Upvote 0
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
 
Upvote 0
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.
Mã:
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
 
Lần chỉnh sửa cuối:
Upvote 0
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ử:
PHP:
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
 
Upvote 0
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
Mã:
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
 
Upvote 0
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
Mã:
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
 
Upvote 0
Dạ vâng em cảm ơn các anh (chị) đã giúp đỡ em !
 
Upvote 0
Web KT
Back
Top Bottom