diepminhhong
Thành viên mới

- Tham gia
- 4/8/09
- Bài viết
- 46
- Được thích
- 8
Các bác có thể giúp em xóa dòng trắng trong bảng số liệu như file em gửi giúp e được k ạ? E cảm ơn nhiều!
Sub DeleteEmptyTablerowsandcolumns()
Application.ScreenUpdating = False
Dim Tbl As Table, cel As Cell, i As Long, n As Long, fEmpty As Boolean
With ActiveDocument
For Each Tbl In .Tables
n = Tbl.Columns.Count
For i = n To 1 Step -1
fEmpty = True
For Each cel In Tbl.Columns(i).Cells
If Len(cel.Range.Text) > 2 Then
fEmpty = False
Exit For
End If
Next cel
If fEmpty = True Then Tbl.Columns(i).Delete
Next i
Next Tbl
End With
With ActiveDocument
For Each Tbl In .Tables
n = Tbl.Rows.Count
For i = n To 1 Step -1
fEmpty = True
For Each cel In Tbl.Rows(i).Cells
If Len(cel.Range.Text) > 2 Then
fEmpty = False
Exit For
End If
Next cel
If fEmpty = True Then Tbl.Rows(i).Delete
Next i
Next Tbl
End With
Set cel = Nothing: Set Tbl = Nothing
Application.ScreenUpdating = True
End Sub
Mở file word >> Nhấn alt + F11/ Menu Insert/ Module. Rồi paste đoạn sau vào Module >> Nhấn F5.
Sau đó Remove Module vừa chèn rồi lưu file lại.Mã:Sub DeleteEmptyTablerowsandcolumns() Application.ScreenUpdating = False Dim Tbl As Table, cel As Cell, i As Long, n As Long, fEmpty As Boolean With ActiveDocument For Each Tbl In .Tables n = Tbl.Columns.Count For i = n To 1 Step -1 fEmpty = True For Each cel In Tbl.Columns(i).Cells If Len(cel.Range.Text) > 2 Then fEmpty = False Exit For End If Next cel If fEmpty = True Then Tbl.Columns(i).Delete Next i Next Tbl End With With ActiveDocument For Each Tbl In .Tables n = Tbl.Rows.Count For i = n To 1 Step -1 fEmpty = True For Each cel In Tbl.Rows(i).Cells If Len(cel.Range.Text) > 2 Then fEmpty = False Exit For End If Next cel If fEmpty = True Then Tbl.Rows(i).Delete Next i Next Tbl End With Set cel = Nothing: Set Tbl = Nothing Application.ScreenUpdating = True End Sub
Link: https://www.extendoffice.com/documents/word/721-word-remove-empty-rows-columns-in-table.html
Mở file word >> Nhấn alt + F11/ Menu Insert/ Module. Rồi paste đoạn sau vào Module >> Nhấn F5.
Sau đó Remove Module vừa chèn rồi lưu file lại.Mã:Sub DeleteEmptyTablerowsandcolumns() Application.ScreenUpdating = False Dim Tbl As Table, cel As Cell, i As Long, n As Long, fEmpty As Boolean With ActiveDocument For Each Tbl In .Tables n = Tbl.Columns.Count For i = n To 1 Step -1 fEmpty = True For Each cel In Tbl.Columns(i).Cells If Len(cel.Range.Text) > 2 Then fEmpty = False Exit For End If Next cel If fEmpty = True Then Tbl.Columns(i).Delete Next i Next Tbl End With With ActiveDocument For Each Tbl In .Tables n = Tbl.Rows.Count For i = n To 1 Step -1 fEmpty = True For Each cel In Tbl.Rows(i).Cells If Len(cel.Range.Text) > 2 Then fEmpty = False Exit For End If Next cel If fEmpty = True Then Tbl.Rows(i).Delete Next i Next Tbl End With Set cel = Nothing: Set Tbl = Nothing Application.ScreenUpdating = True End Sub
Link: https://www.extendoffice.com/documents/word/721-word-remove-empty-rows-columns-in-table.html
Bạn thử đoạn sau:Anh ơi Code hôm qua anh gủi cho em rất hay. N giả sử giờ em muốn xóa hàng 5,6,7,8,9,10,11,12 (như trong file e gửi) thì code như hôm qua k xóa được. A có cách nào k bày cho với a. E cảm ơn anh nhiều.
Sub DellRows()
Application.ScreenUpdating = False
Dim Tbl As Table, i As Long, n As Long
With ActiveDocument
For Each Tbl In .Tables
n = Tbl.Rows.Count
For i = n To 1 Step -1
If Len(Tbl.Cell(i, 2).Range.Text) = 2 Then Tbl.Rows(i).Delete
Next i
Next Tbl
End With
Set Tbl = Nothing
Application.ScreenUpdating = True
End Sub
Bạn thử đoạn sau:
Mã:Sub DellRows() Application.ScreenUpdating = False Dim Tbl As Table, i As Long, n As Long With ActiveDocument For Each Tbl In .Tables n = Tbl.Rows.Count For i = n To 1 Step -1 If Len(Tbl.Cell(i, 2).Range.Text) = 2 Then Tbl.Rows(i).Delete Next i Next Tbl End With Set Tbl = Nothing Application.ScreenUpdating = True End Sub
Bạn thử đoạn sau:
Mã:Sub DellRows() Application.ScreenUpdating = False Dim Tbl As Table, i As Long, n As Long With ActiveDocument For Each Tbl In .Tables n = Tbl.Rows.Count For i = n To 1 Step -1 If Len(Tbl.Cell(i, 2).Range.Text) = 2 Then Tbl.Rows(i).Delete Next i Next Tbl End With Set Tbl = Nothing Application.ScreenUpdating = True End Sub
CỘNG HOÀ XÃ HỘI CHỦ NGHĨA VIỆT NAM |
Độc lập - Tự do - Hạnh phúc |
Sub DellRows()
Application.ScreenUpdating = False
Dim Tbl As Table, i As Long, n As Long
With ActiveDocument
For Each Tbl In .Tables
n = Tbl.Rows.Count
c = Tbl.Columns.Count ''them bien cot
For i = n To 1 Step -1
If c = 1 Then ''neu chi co 1 cot thi kiem tra gia tri cua row o cot 1
If Len(Tbl.Cell(i, 1).Range.Text) = 2 Then Tbl.Rows(i).Delete
Else ''neu nhieu hon 1 cot, thi kiem tra gia tri cua row o cot 2
If Len(Tbl.Cell(i, 2).Range.Text) = 2 Then Tbl.Rows(i).Delete
End If
Next i
Next Tbl
End With
Set Tbl = Nothing
Application.ScreenUpdating = True
End Sub
Sửa code tạm lại cho bạn:
Mã:Sub DellRows() Application.ScreenUpdating = False Dim Tbl As Table, i As Long, n As Long With ActiveDocument For Each Tbl In .Tables n = Tbl.Rows.Count c = Tbl.Columns.Count ''them bien cot ... End Sub
Sub DellRows2()
Application.ScreenUpdating = False
Dim Tbl As Table, i As Long, n As Long
With ActiveDocument
For Each Tbl In .Tables
n = Tbl.Rows.Count
For i = n To 1 Step -1
If Tbl.Columns.Count = 1 Then
If Len(Tbl.Cell(i, 1).Range.Text) = 2 Then Tbl.Rows(i).Delete
Else
If Len(Tbl.Cell(i, 2).Range.Text) = 2 Then Tbl.Rows(i).Delete
End If
Next i
Next Tbl
End With
Set Tbl = Nothing
Application.ScreenUpdating = True
End Sub