Xóa giúp em dòng trắng trong bảng số liệu

[diepminhhong]

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!

 

[befaint]

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!

Mở file word >> Nhấn alt + F11/ Menu Insert/ Module. Rồi paste đoạn sau vào Module >> Nhấn F5.

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

Sau đó Remove Module vừa chèn rồi lưu file lại.

Link: https://www.extendoffice.com/documents/word/721-word-remove-empty-rows-columns-in-table.html

 

[diepminhhong]

Mở file word >> Nhấn alt + F11/ Menu Insert/ Module. Rồi paste đoạn sau vào Module >> Nhấn F5.

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

Sau đó Remove Module vừa chèn rồi lưu file lại.

Link: https://www.extendoffice.com/documents/word/721-word-remove-empty-rows-columns-in-table.html

E cảm ơn bác nhiều. Chúc bác sức khỏe và thành công!

 

[diepminhhong]

Mở file word >> Nhấn alt + F11/ Menu Insert/ Module. Rồi paste đoạn sau vào Module >> Nhấn F5.

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

Sau đó Remove Module vừa chèn rồi lưu file lại.

Link: https://www.extendoffice.com/documents/word/721-word-remove-empty-rows-columns-in-table.html

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.

 

[befaint]

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.

Bạn thử đoạn sau:

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

 

[diepminhhong]

Bạn thử đoạn sau:

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

Em cảm ơn anh befaint nhiều nhá. Chúc anh sức khỏe và thành công.!

 

[diepminhhong]

Bạn thử đoạn sau:

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

Anh bafaint ơi cho em hỏi. Code anh viết và gửi cho e để xóa trắng bảng số liệu trong Word. E xóa bảng số liệu (như file Word đính kèm) thì nó báo lỗi "If Len(Tbl.Cell(i, 2).Range.Text) = 2 Then " và tô màu vàng. Anh có thể giúp em khắc phục lỗi đó được không ạ. E cảm ơn anh nhiều. Chúc anh Sức khỏe và thành công ạ.

 

[mapcongtu]

If Len(Tbl.Cell(i, 2).Range.Text) = 2 Then Tbl.Rows(i).Delete ==> đoạn code này lấy dữ liệu ở cột 2=> Cell(i, 2), trong khi table không có cột 2 nên bị lỗi
----
Trong file này "File chạy bị lỗi.docx", page 4 table chỉ có 1 cột nên bị lỗi

CỘNG HOÀ XÃ HỘI CHỦ NGHĨA VIỆT NAM

Độc lập - Tự do - Hạnh phúc

 

[mapcongtu]

Sửa code tạm lại cho bạn:

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

 

[befaint]

Sửa code tạm lại cho bạn:

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

Chào mapcongtu,
Cảm ơn bạn.
Nếu thêm biến thì nhớ khai báo: Dim c...
Hoặc viết gộp như vầy:

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