Hỗ trợ xóa dòng trống - dữ liệu nhiều

[Nguyenhoangphong0902]

Em chào các anh chị. Công việc của em hay làm với dữ liệu nhiều. Thường là phải thêm dòng, thêm dữ liệu, rồi xóa dữ liệu xóa dòng trống. Em có 1 đoạn code xóa được dòng trống. Nhưng mà với dữ liệu lớn thì ko dám dùng. Hay bị quay quay. Với việc xóa dòng trống (nhiều dòng trống) thì có cách nào xóa nhanh được không các anh chị. Em cảm ơn

Sub removeEmptyRow()

Dim iCntr

Dim rng As Range

Dim dong_cuoi As Long

dong_cuoi = Sheet1.Range("A" & Rows.Count).End(xlUp).Row

Set rng = Range("A1:Z" & dong_cuoi)

For iCntr = rng.Row + rng.Rows.Count - 1 To rng.Row Step -1

If Application.WorksheetFunction.CountA(Rows(iCntr)) = 0 Then Rows(iCntr).EntireRow.Delete

Next

End Sub

 

[ptm0412]

Filter dòng trống, xóa 1 cái rẹt.

 

[Maika8008]

Em chào các anh chị. Công việc của em hay làm với dữ liệu nhiều. Thường là phải thêm dòng, thêm dữ liệu, rồi xóa dữ liệu xóa dòng trống. Em có 1 đoạn code xóa được dòng trống. Nhưng mà với dữ liệu lớn thì ko dám dùng. Hay bị quay quay. Với việc xóa dòng trống (nhiều dòng trống) thì có cách nào xóa nhanh được không các anh chị. Em cảm ơn

Sub removeEmptyRow()

Dim iCntr

Dim rng As Range

Dim dong_cuoi As Long

dong_cuoi = Sheet1.Range("A" & Rows.Count).End(xlUp).Row

Set rng = Range("A1:Z" & dong_cuoi)

For iCntr = rng.Row + rng.Rows.Count - 1 To rng.Row Step -1

If Application.WorksheetFunction.CountA(Rows(iCntr)) = 0 Then Rows(iCntr).EntireRow.Delete

Next

End Sub

Union các dòng trống lại rồi xoá 1 lần.

 

[Nguyenhoangphong0902]

Union các dòng trống lại rồi xoá 1 lần.

Ý em là thế này nè: VD mình có khoảng vài ngàn dòng trống. Cho dù là filter kiểu gì xóa nó cũng quay. Nhưng khi em bỏ vào trong power query thì xóa rất ngọt. Nhưng làm thông qua Power Query thì nó tốn công đoạn, không tự động được. Nói chung: Power Query thì xóa nhanh mà không làm tự động được. Còn code VBA của em gửi ở trên thì tự động được mà lại không nhanh. Giờ em muốn kết hợp, vừa tự động vừa nhanh thì được không anh ?

 

[ptm0412]

Thử thay
"If Application.WorksheetFunction.CountA(Rows(iCntr)) = 0 Then"
bằng
If Application.WorksheetFunction.CountA(Range("A & iCntr & ":Z" & iCntr)) = 0 Then
sẽ thấy nhanh ít nhất gấp đôi

Ghi chú:

Nếu chỉ xóa 1 lần thì chấp nhận chậm 1 chút, nếu xóa nhiều lần trên cùng 1 sheet thì phải xem lại cách nhập liệu: thêm xóa sửa, đừng tạo dòng trống nữa.

 

[vanthinh3101]

Ý em là thế này nè: VD mình có khoảng vài ngàn dòng trống. Cho dù là filter kiểu gì xóa nó cũng quay. Nhưng khi em bỏ vào trong power query thì xóa rất ngọt. Nhưng làm thông qua Power Query thì nó tốn công đoạn, không tự động được. Nói chung: Power Query thì xóa nhanh mà không làm tự động được. Còn code VBA của em gửi ở trên thì tự động được mà lại không nhanh. Giờ em muốn kết hợp, vừa tự động vừa nhanh thì được không anh ?

Bạn thử suy nghĩ theo 1 hướng khác đi.
Đưa toàn bộ dữ liệu cũ vào 1 mảng 2 chiều.
Chạy vòng lặp qua từng phần tử của chiều thứ nhất, nếu có dữ liệu thì chuyển sang mảng kết quả.
Xóa toàn bộ dữ liệu cũ, điền mảng kết quả.
Tôi nghĩ như vậy sẽ không bị đơ máy nếu dữ liệu nhiều.

 

[Hoàng Tuấn 868]

Ý em là thế này nè: VD mình có khoảng vài ngàn dòng trống. Cho dù là filter kiểu gì xóa nó cũng quay. Nhưng khi em bỏ vào trong power query thì xóa rất ngọt. Nhưng làm thông qua Power Query thì nó tốn công đoạn, không tự động được. Nói chung: Power Query thì xóa nhanh mà không làm tự động được. Còn code VBA của em gửi ở trên thì tự động được mà lại không nhanh. Giờ em muốn kết hợp, vừa tự động vừa nhanh thì được không anh ?

Bạn thử gửi file ví dụ với vài ngàn dòng xem sao.

 

[Nguyenhoangphong0902]

Bạn thử gửi file ví dụ với vài ngàn dòng xem sao.

Dữ liệu thì mình không gửi được nhé. Nhưng mà mô phổng thì được. Mình gửi bác file 10 ngàn dòng này thử. Thêm dòng trống thì ko tới 3s mà xóa dòng trống thì...............quay ngay. Mà đây chỉ là 10K thôi đấy.......(bình thường mình làm, nhiều hơn con số này). Thao tác chèn dòng trống có: 2 Inputbox nhé. cái đầu là số dòng trống, cái thứ 2 là sau dòng thứ bao nhiêu......

 

[ptm0412]

Dữ liệu thì mình không gửi được nhé. Nhưng mà mô phổng thì được. Mình gửi bác file 10 ngàn dòng này thử. Thêm dòng trống thì ko tới 3s mà xóa dòng trống thì...............quay ngay. Mà đây chỉ là 10K thôi đấy.......(bình thường mình làm, nhiều hơn con số này). Thao tác chèn dòng trống có: 2 Inputbox nhé. cái đầu là số dòng trống, cái thứ 2 là sau dòng thứ bao nhiêu......

Code xóa dòng làm theo cách của code chèn dòng đi: xài mảng

 

[vanthinh3101]

Dữ liệu thì mình không gửi được nhé. Nhưng mà mô phổng thì được. Mình gửi bác file 10 ngàn dòng này thử. Thêm dòng trống thì ko tới 3s mà xóa dòng trống thì...............quay ngay. Mà đây chỉ là 10K thôi đấy.......(bình thường mình làm, nhiều hơn con số này). Thao tác chèn dòng trống có: 2 Inputbox nhé. cái đầu là số dòng trống, cái thứ 2 là sau dòng thứ bao nhiêu......

Thử code:

Sub RemoveBlankRows()
    Dim lR As Long, I As Long, J As Long, K As Long
    Dim sArr()
    
    Application.ScreenUpdating = False
    
    lR = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    
    sArr() = Sheet1.Range("A1:I" & lR).Value
    
    For I = LBound(sArr, 1) To UBound(sArr, 1)
        If Len(sArr(I, 1)) Then
            K = K + 1
            For J = 1 To UBound(sArr, 2)
                sArr(K, J) = sArr(I, J)
            Next J
        End If
    Next I
    
    Sheet1.Range("A1:I" & lR).Clear
    Sheet1.Range("A1").Resize(K, UBound(sArr, 2)) = sArr
    
    Application.ScreenUpdating = True
End Sub

 

[Nguyenhoangphong0902]

Thử code:

Sub RemoveBlankRows()
    Dim lR As Long, I As Long, J As Long, K As Long
    Dim sArr()
   
    Application.ScreenUpdating = False
   
    lR = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
   
    sArr() = Sheet1.Range("A1:I" & lR).Value
   
    For I = LBound(sArr, 1) To UBound(sArr, 1)
        If Len(sArr(I, 1)) Then
            K = K + 1
            For J = 1 To UBound(sArr, 2)
                sArr(K, J) = sArr(I, J)
            Next J
        End If
    Next I
   
    Sheet1.Range("A1:I" & lR).Clear
    Sheet1.Range("A1").Resize(K, UBound(sArr, 2)) = sArr
   
    Application.ScreenUpdating = True
End Sub

Code này viết bằng mảng có khác, nhanh hơn liền. Cảm ơn anh.