HƯỚNG DẪN XÓA DÒNG TRỐNG VỚI SỐ LƯỢNG DÒNG NHIỀU TRÊN 10.000 DÒNG

Liên hệ QC

NGUYENCONGDUNG2

Thành viên mới
Tham gia
20/5/24
Bài viết
24
Được thích
1
EM XIN CHÀO CÁC ANH CHỊ TRONG GROUP, EM CÓ FILE EXCELL TẦM HƠN 3MB, SỐ LƯỢNG DÒNG NHIỀU QUÁ, TRONG ĐÓ CÓ NHIỀU DÒNG TRỐNG XEN KẼ, EM ĐĂNG BÀI EM XIN NHỜ ANH CHỊ TRONG GROUP HƯỚNG DẪN EM CÁCH XÓA DÒNG TRỐNG, CÁCH XÓA THÔNG THƯỜNG EM ĐÃ THỬ NHIỀU CÁCH MÀ FILE EXCELL HẦU NHƯ XÓA KHÔNG HẾT ĐƯỢC VÀ HAY BỊ ĐƠ MÁY. EM XIN CẢM ƠN Ạ.
 

File đính kèm

  • T01 (XÓA DÒNG TRỐNG).xls
    3.7 MB · Đọc: 11
EM XIN CHÀO CÁC ANH CHỊ TRONG GROUP, EM CÓ FILE EXCELL TẦM HƠN 3MB, SỐ LƯỢNG DÒNG NHIỀU QUÁ, TRONG ĐÓ CÓ NHIỀU DÒNG TRỐNG XEN KẼ, EM ĐĂNG BÀI EM XIN NHỜ ANH CHỊ TRONG GROUP HƯỚNG DẪN EM CÁCH XÓA DÒNG TRỐNG, CÁCH XÓA THÔNG THƯỜNG EM ĐÃ THỬ NHIỀU CÁCH MÀ FILE EXCELL HẦU NHƯ XÓA KHÔNG HẾT ĐƯỢC VÀ HAY BỊ ĐƠ MÁY. EM XIN CẢM ƠN Ạ.
NỘI QUY CỦA GIẢI PHÁP EXCEL
I. Quy định về nội dung
II. Hình thức của bài viết:

1. Tất cả các bài viết bằng tiếng Việt cần viết có dấu đầy đủ, tránh phạm lỗi chính tả và làm mất đi sự trong sáng của tiếng Việt.
2. Không được viết một câu hỏi nhiều lần hay gửi cùng một câu hỏi trong nhiều box khác nhau. Khi câu hỏi chưa được trả lời thì không có nghĩa là không ai biết thông tin liên quan đến câu hỏi của bạn và mọi người đang tìm thông tin để trả lời cho câu hỏi đó. Các bài viết hay chủ đề cùng nội dung sẽ bị xóa bớt.
3. Không được viết hoa và/hoặc sử dụng màu đỏ trong cả bài viết. Màu đỏ chỉ dành cho người điều hành diễn đàn.
 
Mình hướng dẫn cách xái VBA xóa những dòng trống nha, rùa nhất có thể!

B1: Xác định số dòng & số cột vùng các ô có dữ liệu (DL), đưa chúng vô 2 tham biến đã khai báo;
B2: Khai báo 1 mảng theo vùng DL đã có & đưa vùng DL vô mảng để duyệt
B3: Duyệt theo cột;
B3.1: Trong dòng đang duyệt nếu ô đầu có DL thì tăng biến đếm của mảng lên 1 & chép DL dòng đang duyệt vô mảng;
B3,2: Nếu không có (trống) thì bỏ qua;
Bước trung gian: Kiểm số dòng trong mảng so với số dòng DL ban đầu;
B4: Nếu số dòng trong bước trên liền kề mà khác nhau thì chép DL trong mảng lên (đâu đó) trên trang tính

Chúc các bác vui cả tuần, nha!
 
Bạn có thể dùng đoạn code này. Còn phần tổng cộng bác tùy biến thêm cho nó nhé.

Mã:
Sub xoaDongTrong()
       Dim ws As Worksheet
       Dim lr As Long
       Dim arr As Variant, kq As Variant
      
       Set ws = ThisWorkbook.Sheets("Sheet1")
      
       With ws
            lr = .Range("B" & .Rows.Count).End(xlUp).Row
            If lr < 4 Then Exit Sub
            arr = .Range("B4:V" & lr).Value
            ReDim kq(1 To UBound(arr, 1), 1 To UBound(arr, 2))
          
            For i = 1 To UBound(arr, 1)
                  If Not IsEmpty(arr(i, 1)) Then
                        a = a + 1
                        For j = 1 To UBound(arr, 2)
                              kq(a, j) = arr(i, j)
                        Next j
                  End If
            Next i
            .Range("B2:V" & lr).ClearContents
            If a > 0 Then .Range("B2").Resize(UBound(kq, 1), UBound(kq, 2)).Value = kq
       End With
      
End Sub
 

File đính kèm

  • T01 (XÓA DÒNG TRỐNG).xlsb
    932.6 KB · Đọc: 3
Mã:
Sub xoaDongTrong()
       Dim ws As Worksheet
       Dim lr As Long
       Dim arr As Variant, kq As Variant
       Set ws = ThisWorkbook.Sheets("Sheet1")
       With ws
            lr = .Range("B" & .Rows.Count).End(xlUp).Row
            If lr < 4 Then Exit Sub
            arr = .Range("B4:V" & lr).Value
            ReDim kq(1 To UBound(arr, 1), 1 To UBound(arr, 2))
            For i = 1 To UBound(arr, 1)
                  If Not IsEmpty(arr(i, 1)) Then
                        a = a + 1
                        For j = 1 To UBound(arr, 2)
                              kq(a, j) = arr(i, j)
                        Next j
                  End If
            Next i
            .Range("B2:V" & lr).ClearContents
            If a > 0 Then .Range("B2").Resize(UBound(kq, 1), UBound(kq, 2)).Value = kq
       End With
End Sub
Nên đưa vào thẻ code cho gọn nhỉ.
 
Nên đưa vào thẻ code cho gọn nhỉ.

Nên đưa vào thẻ code cho gọn nhỉ.
Phần tổng cộng này là phần thiết kế hơn bị sai sai của chủ sở hữu file.

Bạn có thể dùng đoạn code này. Còn phần tổng cộng bác tùy biến thêm cho nó nhé.

Mã:
Sub xoaDongTrong()
       Dim ws As Worksheet
       Dim lr As Long
       Dim arr As Variant, kq As Variant
    
       Set ws = ThisWorkbook.Sheets("Sheet1")
    
       With ws
            lr = .Range("B" & .Rows.Count).End(xlUp).Row
            If lr < 4 Then Exit Sub
            arr = .Range("B4:V" & lr).Value
            ReDim kq(1 To UBound(arr, 1), 1 To UBound(arr, 2))
        
            For i = 1 To UBound(arr, 1)
                  If Not IsEmpty(arr(i, 1)) Then
                        a = a + 1
                        For j = 1 To UBound(arr, 2)
                              kq(a, j) = arr(i, j)
                        Next j
                  End If
            Next i
            .Range("B2:V" & lr).ClearContents
            If a > 0 Then .Range("B2").Resize(UBound(kq, 1), UBound(kq, 2)).Value = kq
       End With
    
End Sub
 
Lần chỉnh sửa cuối:
Cho em hỏi với ạ, em coppy đoạn code này vô file, sao em bấm run mà không chạy nhỉ, có cần phải thao tác gì không ạ, bôi đen vùng dữ liệu hay chỉ cấn bôi đen cột thôi, em cũng hay dùng đoạn code VBA nhiều lần rồi, sao lần này em dùng không được, em cảm ơn ạ.
Bài đã được tự động gộp:





Cho em hỏi với ạ, em coppy đoạn code này vô file, sao em bấm run mà không chạy nhỉ, có cần phải thao tác gì không ạ, bôi đen vùng dữ liệu hay chỉ cấn bôi đen cột thôi, em cũng hay dùng đoạn code VBA nhiều lần rồi, sao lần này em dùng không được, em cảm ơn ạ.
Bạn có thể tham khảo công cụ Add-in tự tạo có chức năng Xóa dòng tự động theo điều kiện ở link: https://www.giaiphapexcel.com/diend...tải-file-đính-kèm-trong-email-outlook.166438/
Muốn dùng tốt thì cần xem hướng dẫn sử dụng nhé!
 
Web KT

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

Back
Top Bottom