"thủ tục để xóa dòng trống " trong Lập trình VBA trong Excel

minhbinhdinh · 24/9/09

chào mọi người
mình có thử thủ tục "thủ tục để xóa dòng trống " trong sách Lập trình VBA trong Excel của a PTH như sau :
Sub DeleteEmptyRows()
Dim i As Integer
Dim FirstRow As Integer, LastRow As Integer, UsedRows As Integer
Application.ScreenUpdating = False
'xác định dòng đầu tiên có chứa dữ liệu
FirstRow = ActiveSheet.UsedRange.Row
'xác định số hàng có chứa dữ liệu
UsedRows = ActiveSheet.UsedRange.Rows.Count
'xác định hàng cuối có chứa dữ liệu
LastRow = FirstRow - 1 + UsedRows
For i = LastRow To step - 1 'lùi từng hàng lên trên
'xóa hàng nếu tổng số ô trông hàng có chứa dữ liệu bằng 0(hàng rỗng)
If Application.CountA(Rows(i)) = 0 Then
Rows(i).Delete
Next i
Application.ScreenUpdating = True
End Sub
kết quả là xóa luôn sheet đó luôn.Mình chưa hiểu nó hoạt động như thế nào.
Mong mọi người chỉ giáo

ndu96081631 · 24/9/09

minhbinhdinh đã viết:
chào mọi người
mình có thử thủ tục "thủ tục để xóa dòng trống " trong sách Lập trình VBA trong Excel của a PTH như sau :
Sub DeleteEmptyRows()
Dim i As Integer
Dim FirstRow As Integer, LastRow As Integer, UsedRows As Integer
Application.ScreenUpdating = False
'xác định dòng đầu tiên có chứa dữ liệu
FirstRow = ActiveSheet.UsedRange.Row
'xác định số hàng có chứa dữ liệu
UsedRows = ActiveSheet.UsedRange.Rows.Count
'xác định hàng cuối có chứa dữ liệu
LastRow = FirstRow - 1 + UsedRows
For i = LastRow To step - 1 'lùi từng hàng lên trên
'xóa hàng nếu tổng số ô trông hàng có chứa dữ liệu bằng 0(hàng rỗng)
If Application.CountA(Rows(i)) = 0 Then
Rows(i).Delete
Next i
Application.ScreenUpdating = True
End Sub
kết quả là xóa luôn sheet đó luôn.Mình chưa hiểu nó hoạt động như thế nào.
Mong mọi người chỉ giáo

Làm gì có vụ xóa luôn sheet chứ ---> Bạn đưa nguyên file + Code lên đây thử xem!
Code này tôi sửa lại như sau:

PHP:

Sub DeleteEmptyRows()
  Dim i As Long
  Application.ScreenUpdating = False
  With Sheet1.UsedRange
    For i = .Rows.Count To 1 Step -1
      If WorksheetFunction.CountA(.Cells(i, 1).EntireRow) = 0 Then
        .Cells(i, 1).EntireRow.Delete
      End If
    Next i
  End With
  Application.ScreenUpdating = True
End Sub

minhbinhdinh · 24/9/09

thành thật xin lỗi mọi người.
1) Tôi lộn với " thủ tục xóa sheet rỗng" ở trang bên cạnh . Nhưng mà thủ tục này nó cũng không xóa được dòng rỗng .
2) Còn "thủ tục xóa sheet rỗng " này thì thế nào đó : Nó xóa sheet có dữ liệu chứ không phải xóa sheet rỗng.trước khi xóa xuất hiện thông báo : "Data may exist in the sheet(s) selected for deletion.To pertmanently delete the data ,press Delete"
3) nhờ anh ndu, trung chinh và .....xem giúp " tự động khóa vùng data " .tôi đang cần giải quyết vấn đề này gấp 1 tí .
Cảm ơn mọi người.

ndu96081631 · 24/9/09

minhbinhdinh đã viết:
thành thật xin lỗi mọi người.
1) Tôi lộn với " thủ tục xóa sheet rỗng" ở trang bên cạnh . Nhưng mà thủ tục này nó cũng không xóa được dòng rỗng .
2) Còn "thủ tục xóa sheet rỗng " này thì thế nào đó : Nó xóa sheet có dữ liệu chứ không phải xóa sheet rỗng.trước khi xóa xuất hiện thông báo : "Data may exist in the sheet(s) selected for deletion.To pertmanently delete the data ,press Delete"
3) nhờ anh ndu, trung chinh và .....xem giúp " tự động khóa vùng data " .tôi đang cần giải quyết vấn đề này gấp 1 tí .
Cảm ơn mọi người.

Xóa sheet rổng thì cần gì duyệt qua các cells
Vầy nè:

PHP:

Sub xoasheetrong()
  Dim Ws As Worksheet
  On Error Resume Next
  Application.DisplayAlerts = False
  For Each Ws In ThisWorkbook.Worksheets
    If WorksheetFunction.CountA(Ws.Cells) = 0 Then
      Ws.Delete
    End If
  Next
  Application.DisplayAlerts = True
End Sub

Nói chung là tạm dùng được!

PhanTuHuong · 24/9/09

ndu96081631 đã viết:
Xóa sheet rổng thì cần gì duyệt qua các cells
Vầy nè:

PHP:

Sub xoasheetrong() Dim Ws As Worksheet On Error Resume Next Application.DisplayAlerts = False For Each Ws In ThisWorkbook.Worksheets If WorksheetFunction.CountA(Ws.Cells) = 0 Then Ws.Delete End If Next Application.DisplayAlerts = True End Sub

Nói chung là tạm dùng được!

Em bổ sung thêm nữa:

Mã:

Sub xoasheetrong()
  Dim Ws As Worksheet
  On Error Resume Next
  Application.DisplayAlerts = False
  For Each Ws In ThisWorkbook.Worksheets
    If IsEmpty(Ws.UsedRange) Then
      Ws.Delete
    End If
  Next
  Application.DisplayAlerts = True
End Sub

nghiaquangtran · 26/9/09

Nếu mình muốn xóa dòng trống nhưng chỉ có những vùng có nhiều hơn 3 dòng trống liền nhau thì xóa và vẫn giữ lại 3 dòng trống
...cụ thể là mình có nhiều table data nằm cách nhau, mình muốn cắt bỏ dòng trống sao cho mỗi table nằm cách nhau 3 dòng trống.

Cám ơn

ndu96081631 · 26/9/09

nghiaquangtran đã viết:
Nếu mình muốn xóa dòng trống nhưng chỉ có những vùng có nhiều hơn 3 dòng trống liền nhau thì xóa và vẫn giữ lại 3 dòng trống
...cụ thể là mình có nhiều table data nằm cách nhau, mình muốn cắt bỏ dòng trống sao cho mỗi table nằm cách nhau 3 dòng trống.

Cám ơn

Theo ý kiến của cá nhân tôi: Bạn không nên bố trí dử liệu theo kiểu vậy ---> 2 bảng khác nhau lại nằm cùng 1 cột? Mai này sao quản lý dử liệu?
- Một là gộp chúng lại với nhau
- Hai là chuyển từng bảng sang từng sheet riêng

nghiaquangtran · 26/9/09

ndu96081631 đã viết:
Theo ý kiến của cá nhân tôi: Bạn không nên bố trí dử liệu theo kiểu vậy ---> 2 bảng khác nhau lại nằm cùng 1 cột? Mai này sao quản lý dử liệu?
- Một là gộp chúng lại với nhau
- Hai là chuyển từng bảng sang từng sheet riêng

Cám ơn ndu

Bảng sl của mình không phải là sl thô...

Mình dùng các soft khác (SPSS, Epidata...) để xử lý sl và chạy các ứng dụng phân tích thống kê và xuất kết quả ra excel ở dạng các bảng chéo nhiều hàng và nhiều cột, một số phần mềm khi dán data vào excel đã để các bảng sl này cách nhau rất xa (khoảng 20 dòng), nên đôi khi mình phải tự delete những dòng trống này thủ công để các bảng biểu này nằm gần nhau tiện cho việc phân tích sl, nhưng khi làm công việc phân tích thống kê đòi hỏi phải có nhiều bảng biểu sl thì làm thủ công cắt bỏ dòng trống rất mất thời gian.

joga7785 · 8/10/09

Hay quá. Mình vừa dịp cần dùng 2 cái thủ tục này.

Sub DeleteEmptyRows()
Dim i As Long
Application.ScreenUpdating = False
With Sheet1.UsedRange
For i = .Rows.Count To 1 Step -1
If WorksheetFunction.CountA(.Cells(i, 1).EntireRow) = 0 Then
.Cells(i, 1).EntireRow.Delete
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
Sub xoasheetrong()
Dim Ws As Worksheet
On Error Resume Next
Application.DisplayAlerts = False
For Each Ws In ThisWorkbook.Worksheets
If IsEmpty(Ws.UsedRange) Then
Ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub

joga7785 · 8/10/09

Sub DeleteEmptyRows()
Dim i As Long
Application.ScreenUpdating = False
With Sheet1.UsedRange
For i = .Rows.Count To 1 Step -1
If WorksheetFunction.CountA(.Cells(i, 1).EntireRow) = 0 Then
.Cells(i, 1).EntireRow.Delete
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
Sub xoasheetrong()
Dim Ws As Worksheet
On Error Resume Next
Application.DisplayAlerts = False
For Each Ws In ThisWorkbook.Worksheets
If IsEmpty(Ws.UsedRange) Then
Ws.Delete
End If
Next
Application.DisplayAlerts = True
End Sub

giamngucgames · 14/10/09

Sheet trống thì xóa được còn dòng thì không nhờ các bạn xem lại giúp

ptlong04x1 · 14/10/09

giamngucgames đã viết:
Sheet trống thì xóa được còn dòng thì không nhờ các bạn xem lại giúp

Mình thấy các code trên đã giải quyết vấn đề này rồi, xem lại đi bạn.

heo205 · 27/10/09

Mấy anh, chị ơi mấy cái code này minh sẽ nhập vào đâu ha.........

Locdulieu · 31/5/12

Em làm được code chạy mà vẫn không hiểu tại sao...
AC giải thích dùm em chỗ này nhé...
Sub To_mau_nen()
With Sheet2.UsedRange
For i = .Rows.Count To 6 Step -1
If Cells(i, 5).Font.Bold Or Cells(i, 6).Font.Bold Or Cells(i, 7).Font.Bold Then
i = i
Else
Rows(i).Delete

End If
Next
End With
End Sub
Dòng chữ màu xanh khi điều kiện chọn thỏa mãn là chữ tô đậm thì ---> giữ lại không xóa (mà ko biết dùng lệnh gì) đành ghi: " i=i "
còn ko thỏa mãn đều kiện thì xóa là Ok rùi...
AC giải thích giúp em chỗ này nhé...Xin cảm ơn thật nhiều
Em gửi file lên ...

Quang_Hải · 31/5/12

viết thế này cũng xoá được dòng có ô in đậm, muốn ngược lại thi sửa True thành False

For Each cell In [e6:g60]
If cell.Font.Bold = True Then cell.EntireRow.Delete
Next

Locdulieu · 31/5/12

For Each cell In [e6:g60]
If cell.Font.Bold = True Then cell.EntireRow.Delete
Next

Em sửa lại code theo anh nó lại xóa các dòng được tô đậm chứ không xóa các dòng không được tô đậm.
Ý em là muôn xóa các dòng không có chữ tô đậm, nhưng không hiểu về Vba lắm nên viết dài dòng và khó hiểu.
Anh có thể sửa code theo file em gửi và gửi lại giúp em được không,xin cảm ơn anh thật nhiều.

.

Locdulieu · 31/5/12

viết thế này cũng xoá được dòng có ô in đậm, muốn ngược lại thi sửa True thành False

Em sửa "true" thành "false" nó vẫn xóa các dòng có chữ in đậm anh ơi, Anh sửa code vô file giúp em nhé.....Thanks Anh.

Quang_Hải · 31/5/12

Sub Xoa()
Application.ScreenUpdating = 0
For r = [g65536].End(3).Row To 6 Step -1
If Cells(r, 5).Font.Bold = 0 Then
If Cells(r, 6).Font.Bold = 0 Then
If Cells(r, 7).Font.Bold = 0 Then
Cells(r, 5).EntireRow.Delete
End If
End If
End If
Next
Application.ScreenUpdating = 0
End Sub

concogia · 31/5/12

Locdulieu đã viết:
Em sửa "true" thành "false" nó vẫn xóa các dòng có chữ in đậm anh ơi, Anh sửa code vô file giúp em nhé.....Thanks Anh.

Với code trên, dòng nào có cả 3 cell in đậm thì nó mới "tha", còn không nó....."thịt" hết
Túm lại, không nên dùng For Each...
Híc

Locdulieu · 31/5/12

Với code trên, dòng nào có cả 3 cell in đậm thì nó mới "tha", còn không nó....."thịt" hết

Chổ này em ngoài cách dùng "Or" thì còn cách nào nữa không bác Cò già, xin chỉ giáo cho em vài chiêu để em hiểu thêm ít nhiều....Xin cảm ơn.

"thủ tục để xóa dòng trống " trong Lập trình VBA trong Excel

Thành viên chính thức

Huyền thoại GPE

Thành viên chính thức

File đính kèm

Huyền thoại GPE

VBA & VB.NET for Excel & AutoCad

Thành viên chính thức

Huyền thoại GPE

Thành viên chính thức

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên tích cực

Thành viên mới

Thành viên mới

File đính kèm

Thành viên gạo cội

Thành viên mới

Thành viên mới

Thành viên gạo cội

Gội rồi mới Cạo

Thành viên mới

Đếm ngược thời gian