Xin Anh, Chị chỉ code xóa các dong xen giữa không có dữ liệu (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

haikimcuong

Thành viên hoạt động
Tham gia
6/7/10
Bài viết
169
Được thích
36
Tình hình là thế này ạ, em đang muốn xóa các dòng trống xen giữa các dòng có dữ liệu như file em đã gửi kèm và cái khó là dòng dữ liệu nó được sắp xếp k đều có thể 1 dòng có dữ liệu 1 dòng trắng rồi lại 1 dong dữ liệu và cách 2 đến 3 dòng trắng nên sẽ k thể lọc được hay theo hàm lấy chẵn lẻ nên em đã tạo nút bấm để nhờ các anh khi có dữ liệu dạng em ví dụ thì chỉ việc copy vào đó và ấn dồn dòng là nó sẽ tự xóa tất cả các dòng xen kẽ để dữ liệu liền nhau, Em luôn phải làm việc với 1 cơ số lớn loại dữ liệu kiểu này và thường phải xử lý dữ liệu bằng cách xóa thủ công rất lâu vì có những lúc lên đến gần 400 người. Mong Anh chị giúp đỡ em.
 

File đính kèm

[GPECODE][/GPECODE]
Tại e thấy trong File ko có rỗng cột A mà cột B có dl nên mạo muội làm đại vậy, nếu có phát sinh mong Thầy giúp đỡ cho em học hỏi.
Em cảm ơn!
thì thêm điều kiện cho nó thôi, nếu dự liệu nhiều cột thì khác (xem count của dòng nào = 0 thì delete dòng đó luôn) còn ở đây có 2 cột à
If data(i, 1) <> "" Then
If data(i, 2) <> "" Then
hoặc If data(i, 1) <> "" and data(i, 2) <> "" Then
" làm theo bài của bạn"


Code Xóa Dòng rỗng trong phạm vi bảng dự liệu (ko xóa cả dòng)
[GPECODE=vb]Option Explicit

Sub dondong()
Dim data(), Result(), i%, j%, x%, D%
D = [iv3].End(xlToLeft).Column
data = Range([A3], [A65536].End(3)).Resize(, D).FormulaR1C1
ReDim Result(1 To UBound(data, 1), 1 To D)
For i = 1 To UBound(data, 1)
If WorksheetFunction.CountA(Cells(i + 2, 1).Resize(1, D)) > 0 Then
x = x + 1
For j = 1 To D
Result(x, j) = data(i, j)
Next
End If
Next
Range([A3], [A65536].End(3)).Resize(, D).ClearContents
[A3].Resize(x, D) = Result
End Sub



[/GPECODE]
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Private Sub CommandButton1_Click()
Dim i&, str$
For i = UsedRange.Row To UsedRange.Row + UsedRange.Rows.Count
If Application.CountA(Cells(i, 1).EntireRow) = 0 Then
str = str & "," & i & ":" & i
End If
Next
If str <> vbNullString Then
str = Right(str, Len(str) - 1)
Range(str).Delete
End If
End Sub
 
Upvote 0
Tình hình là thế này ạ, em đang muốn xóa các dòng trống xen giữa các dòng có dữ liệu như file em đã gửi kèm và cái khó là dòng dữ liệu nó được sắp xếp k đều có thể 1 dòng có dữ liệu 1 dòng trắng rồi lại 1 dong dữ liệu và cách 2 đến 3 dòng trắng nên sẽ k thể lọc được hay theo hàm lấy chẵn lẻ nên em đã tạo nút bấm để nhờ các anh khi có dữ liệu dạng em ví dụ thì chỉ việc copy vào đó và ấn dồn dòng là nó sẽ tự xóa tất cả các dòng xen kẽ để dữ liệu liền nhau, Em luôn phải làm việc với 1 cơ số lớn loại dữ liệu kiểu này và thường phải xử lý dữ liệu bằng cách xóa thủ công rất lâu vì có những lúc lên đến gần 400 người. Mong Anh chị giúp đỡ em.

Làm thủ công đâu có lâu la gì, quan trọng là cách làm. Thuật giải là tìm cách cho ẩn các dòng có dữ liệu rồi rút các dòng đang hiện trên màn hình.

Bạn thử làm theo các cách sau rồi chọn lấy cách nào bạn thích.

Cách 1:
- Autofilter cột A, chọn Blanks
- Tại cột A chọn từ dòng đầu đến dòng cuối vùng lọc (trên Row Headers là các dòng có số màu xanh, nếu lỡ tay kéo quá một chút cũng không sao)
- Rút dòng rồi cho các dòng ẩn hiện lại
Nhược điểm của cách này là phải chọn 1 cột nào đó để làm chuẩn.

Cách 2:
- Quét toàn bộ vùng có dữ liệu, nhấn f5 (hoặc Ctrl + G), chọn Special..., nhấn phím O, nhấn OK.
- Chọn Format | Row | Hide (ẩn các dòng đã chọn).
- Quét chọn vùng lọc tại một cột bất kỳ, nhấn f5, chọn Special..., nhấn phím Y, nhấn OK.
- Rút dòng rồi cho các dòng ẩn hiện lại

Viết ra mất 10 phút, đọc mất 1 phút nhưng làm thì chỉ mất khoảng 10 giây.

Muốn viết Code thì cũng viết theo cách này

Ví dụ viết theo cách 2
Mã:
Sub Macro1()
With [a6].Resize(1000, 20)
    .SpecialCells(2).EntireRow.Hidden = True
    .SpecialCells(12).EntireRow.Delete
    .EntireRow.Hidden = False
End With
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Cảm ơn các anh đã giúp đỡ em đã làm được ạ.
 
Upvote 0
Làm thủ công đâu có lâu la gì, quan trọng là cách làm. Thuật giải là tìm cách cho ẩn các dòng có dữ liệu rồi rút các dòng đang hiện trên màn hình.

Bạn thử làm theo các cách sau rồi chọn lấy cách nào bạn thích.

Cách 1:
- Autofilter cột A, chọn Blanks
- Tại cột A chọn từ dòng đầu đến dòng cuối vùng lọc (trên Row Headers là các dòng có số màu xanh, nếu lỡ tay kéo quá một chút cũng không sao)
- Rút dòng rồi cho các dòng ẩn hiện lại
Nhược điểm của cách này là phải chọn 1 cột nào đó để làm chuẩn.

Cách 2:
- Quét toàn bộ vùng có dữ liệu, nhấn f5 (hoặc Ctrl + G), chọn Special..., nhấn phím O, nhấn OK.
- Chọn Format | Row | Hide (ẩn các dòng đã chọn).
- Quét chọn vùng lọc tại một cột bất kỳ, nhấn f5, chọn Special..., nhấn phím Y, nhấn OK.
- Rút dòng rồi cho các dòng ẩn hiện lại

Viết ra mất 10 phút, đọc mất 1 phút nhưng làm thì chỉ mất khoảng 10 giây.

Muốn viết Code thì cũng viết theo cách này

Ví dụ viết theo cách 2
Mã:
Sub Macro1()
With [a6].Resize(1000, 20)
    .SpecialCells(2).EntireRow.Hidden = True
    .SpecialCells(12).EntireRow.Delete
    .EntireRow.Hidden = False
End With
End Sub

Chú cho cháu hỏi cháu làm như thế này thì code bị lỗi không chạy được.
HTML:
Sub XoaDongTrong()
    Range("F7:F19").ClearContents
    Range("E7:E19").Copy
    Range("F7:F19").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
    Range("F7:F19").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Chú có thể cho cháu biết Nguyên nhân và cách khắc phục được không ạ?
Cháu cảm ơn!
 

File đính kèm

Upvote 0
Chú cho cháu hỏi cháu làm như thế này thì code bị lỗi không chạy được.
HTML:
Sub XoaDongTrong()
    Range("F7:F19").ClearContents
    Range("E7:E19").Copy
    Range("F7:F19").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
    Range("F7:F19").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Chú có thể cho cháu biết Nguyên nhân và cách khắc phục được không ạ?
Cháu cảm ơn!

Nguyên nhân là vì khi copy từ cột E sang cột F thì cột F không còn ô nào là Blank hết nên code bị lỗi là phải rồi.
 
Upvote 0
Em cũng nghĩ như vậy?Nhưng thực tế là những ô trong vùng pase cũng không hề có gì cả.
Nhưng có thể xóa cái ô trắng trong vùng vừa Pase dữ liệu đó bằng code được không Anh?
Cảm ơn Anh!
 
Upvote 0
Em cũng nghĩ như vậy?Nhưng thực tế là những ô trong vùng pase cũng không hề có gì cả.
Nhưng có thể xóa cái ô trắng trong vùng vừa Pase dữ liệu đó bằng code được không Anh?
Cảm ơn Anh!
Tạm làm thế này coi sao
PHP:
Sub XoaDongTrong()
   Dim i
   [F7:F19].ClearContents
   For i = 7 To 19
      If Cells(i, 5) <> "" Then Cells(i, 6) = Cells(i, 5)
   Next
   [F7:F19].SpecialCells(4).EntireRow.Delete
End Sub
 
Upvote 0
Cảm ơn anh!
Như vậy trường hợp copy kiểu của em là không có cách nào xóa được những cái ô trống trong vùng màu xanh phải không ạ?
 
Upvote 0
Ví dụ viết theo cách 2
Mã:
Sub Macro1()
With [a6].Resize(1000, 20)
    .SpecialCells(2).EntireRow.Hidden = True
    .SpecialCells(12).EntireRow.Delete
    .EntireRow.Hidden = False
End With
End Sub

Code này của anh thì em nghĩ rằng nên rút lại vầy cho gọn chút xíu
PHP:
Sub Macro1()
    [A6].Resize(1000).SpecialCells(4).EntireRow.Delete
End Sub
Cảm ơn anh!
Như vậy trường hợp copy kiểu của em là không có cách nào xóa được những cái ô trống trong vùng màu xanh phải không ạ?
Mình nghĩ là chắc không được, không biết các anh chị khác có cách nào khác hay không
 
Lần chỉnh sửa cuối:
Upvote 0
Nếu dùng Goto Special không được thì mình lại duyệt qua 1 vòng vùng Paste cái nào mà trống thì xóa, vậy có "củ chuối" quá không Anh Hải?
Củ chuối hay củ khoai gì cũng vậy thôi, miễn là đạt được mục đích là ok. Cách thì có nhiều nhưng ai rành món nào thì xào món đó. Mình vẫn khoái xài mảng để xóa dòng trống.
Bài 12 là dùng cách củ chuối đó mà
 
Upvote 0
Chú cho cháu hỏi cháu làm như thế này thì code bị lỗi không chạy được.
HTML:
Sub XoaDongTrong()
    Range("F7:F19").ClearContents
    Range("E7:E19").Copy
    Range("F7:F19").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
    Range("F7:F19").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Chú có thể cho cháu biết Nguyên nhân và cách khắc phục được không ạ?
Cháu cảm ơn!

Code bị lỗi tại câu lệnh Range("F7:F19").SpecialCells(xlCellTypeBlanks).EntireRow.Delete do trong vùng "F7:F19" không có dòng trống, dòng mà bạn nhìn thấy trống thực chất là có ký tự trắng gì đó.

Cách khắc phục dùng Autofilter để lọc như cách 1 ở bài trên
 
Upvote 0
Code này của anh thì em nghĩ rằng nên rút lại vầy cho gọn chút xíu
PHP:
Sub Macro1()
    [A6].Resize(1000).SpecialCells(4).EntireRow.Delete
End Sub

Trong trường hợp của bài này thì được còn trong trường hợp cột A rỗng, nhưng cột B hoặc C cùng dòng có dữ liệu thì ... tèo em à.
 
Upvote 0

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

Back
Top Bottom