| |||||||||
Cho mình hỏi mình dùng code xóa dòng trống nhiều sheet sao nó chỉ xóa hết dòng trống sheet hiện tại còn các sheet các không xóa hết dòng trống. Cảm ơn
- Thread starter Thbv
- Ngày gửi
- Tham gia
- 8/6/06
- Bài viết
- 14,486
- Được thích
- 22,712
- Nghề nghiệp
- U80
Mình nghĩ xóa không hết có thể là phương thức SpecialCells(xlCellTypeBlanks)
Như mình, chân phương là vầy:
Như mình, chân phương là vầy:
PHP:
Sub XoaDongTongTrongCacTrang()
Dim Ws As Worksheet, Cls As Range, Rng As Range
'On Error Resume Next '
For Each Ws In ActiveWorkbook.Worksheets
If Ws.Name <> "Sheet1" And Ws.Name <> "TongHop" Then
Dim dRg As Range
Set Rng = Ws.Range(Ws.[H1], Ws.[H65500].End(xlUp))
For Each Cls In Rng
If Cls.Value = "" Then
If dRg Is Nothing Then
Set dRg = Rows(Cls.Row & ":" & Cls.Row)
Else
Set dRg = Union(dRg, Rows(Cls.Row & ":" & Cls.Row))
End If
End If
Next Cls
If Not dRg Is Nothing Then
MsgBox dRg.Rows.Count, , Ws.Name: dRg.Delete
Set dRg = Nothing
End If
End If
Next Ws
End Sub
Hoàng Nhật Phương
Thành viên gắn bó
- Tham gia
- 5/11/15
- Bài viết
- 1,894
- Được thích
- 1,214
Bạn chạy sub Main xem được không ạ:
Mã:
Option Explicit
Sub Main()
Dim ws As Worksheet, r As Range, lr As Long
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Sheet1" Then
With ws
lr = .Cells(.Rows.Count, "J").End(xlUp).Row
Set r = .Range("D10:AD" & lr)
RemoveBlankRows r
End With
End If
Next ws
End Sub
Sub RemoveBlankRows(ByVal sRng As Range)
'Code by nickname befaint --- giaiphapexcel
Dim a(), maxR As Long, i As Long, j As Long, k As Long, maxC As Long
Dim Res(), sTxt As String
If sRng.Rows.Count = 1 Then Exit Sub
a = sRng.Value2
maxR = UBound(a, 1)
maxC = UBound(a, 2)
ReDim Res(1 To maxR, 1 To maxC)
For i = 1 To maxR
sTxt = ""
For k = 1 To maxC
sTxt = sTxt & a(i, k)
Next k
If Len(sTxt) > 0 Then
j = j + 1
For k = 1 To maxC
Res(j, k) = a(i, k)
Next k
End If
Next i
sRng.ClearContents
If j > 0 Then sRng.Cells(1, 1).Resize(j, maxC).Value = Res
End SubHoàng Nhật Phương
Thành viên gắn bó
- Tham gia
- 5/11/15
- Bài viết
- 1,894
- Được thích
- 1,214
Chưa được ở chỗ nào sheet nào vậy bạn, bạn tô màu vàng giúp mình chỗ đó nhé.
- Tham gia
- 8/6/06
- Bài viết
- 14,486
- Được thích
- 22,712
- Nghề nghiệp
- U80
Thêm 1 lệnh, như sau:
PHP:
Sub XoaDongTongTrongCacTrang()
Dim Ws As Worksheet, Cls As Range, Rng As Range
'On Error Resume Next '
For Each Ws In ActiveWorkbook.Worksheets
If Ws.Name <> "Sheet1" And Ws.Name <> "TongHop" Then
4 Dim dRg As Range: Ws.Select
Set Rng = Ws.Range(Ws.[H1], Ws.[H65500].End(xlUp))
For Each Cls In Rng
If Cls.Value = "" Then
If dRg Is Nothing Then
Set dRg = Rows(Cls.Row & ":" & Cls.Row)
Else
Set dRg = Union(dRg, Rows(Cls.Row & ":" & Cls.Row))
End If
End If
Next Cls
If Not dRg Is Nothing Then
MsgBox dRg.Rows.Count, , Ws.Name: dRg.Delete
Set dRg = Nothing
End If
End If
Next Ws
End Sub
Cản ơn bạn nhiều
be_09
Biên Hòa, Đồng Nai
- Tham gia
- 9/4/11
- Bài viết
- 9,973
- Được thích
- 9,870
- Nghề nghiệp
- Công chức
Thử 1 cách khác:
Mã:
Sub XoaDong_NeuCotH_Rong()
Application.ScreenUpdating = False
Dim i As Long, j As Long
'Xóa tù Sheet 3 > Sheet 14 (2 sheet bên trái không xóa)
For i = 3 To 14
Sheets(i).Activate
'Loop qua dòng 1500 Tói dòng 10
For j = 1500 To 10 Step -1
'Néu Cell trong côt H là tróng
If Cells(j, 8) = "" Then
'Delete dòng néu côt H có Cell tróng
Rows(j).Delete
End If
Next j
Next i
Application.ScreenUpdating = True
End SubCảm ơn bạn nhiều
Nhờ các bạn giúp code: Sheet T1 cột I dòng 2 đặt hàm Vlookup lấy dữ liệu ở sheet Loaitru (Cột A và B) vlookup đến dòng cuối cùng, sheet T2 cột I đặt hàm Vlookup lấy dữ liệu ở sheet Loaitru (Cột C và D) vlookup đến dòng cuối cùng.............sheet T12 cột I đặt hàm Vlookup lấy dữ liệu ở sheet Loaitru (Cột w và X) vlookup đến dòng cuối cùng. Xin trân trọng cảm ơn bạn nhiều. file đính kèm |
Bài đã được tự động gộp:
Bài đã được tự động gộp:
Rất mong được giúp đỡ.
Bài viết mới nhất
- Question
- Đã giải quyết
