搜索
查看: 2672|回复: 1

删除空行和空列VBA

[复制链接]

978

主题

1094

帖子

1万

积分

管理员

Rank: 9Rank: 9Rank: 9

积分
15950
发表于 2018-8-30 10:24:18 | 显示全部楼层 |阅读模式

'删除空行
Sub DeleteEmptyRows()
Dim LastRow As Long, r As Long
LastRow = ActiveSheet.UsedRange.Rows.Count
LastRow = LastRow + ActiveSheet.UsedRange.Row - 1

For r = LastRow To 1 Step -1
    If WorksheetFunction.CountA(Rows(r)) = 0 Then Rows(r).Delete
    Next r
   
End Sub
'删除空列
Sub DeleteEmptyColumns()
Dim LastColumn As Long, c As Long
LastColumn = ActiveSheet.UsedRange.Columns.Count
LastColumn = LastColumn + ActiveSheet.UsedRange.Column

For c = LastColumn To 1 Step -1
    If WorksheetFunction.CountA(Columns(c)) = 0 Then Columns(c).Delete
    Next c
   
End Sub
回复

使用道具 举报

978

主题

1094

帖子

1万

积分

管理员

Rank: 9Rank: 9Rank: 9

积分
15950
 楼主| 发表于 2018-8-30 10:25:44 | 显示全部楼层
Private Sub CommandButton1_Click()
    MsgBox ("消息框")
End Sub

Private Sub CommandButton2_Click()
    Delete_Empty_Rows
End Sub

Private Sub CommandButton3_Click()
    Delete_Empty_Columns
End Sub
'Option Explicit
'删除所选区空行
Sub Delete_Empty_Rows()
    Dim rnArea As Range
    Dim lnLastRow As Long, i As Long, j As Long

    Application.ScreenUpdating = False
    lnLastRow = Selection.Rows.Count
    Set rnArea = Selection

     If rnArea.Rows.Count <= 1 Then
        MsgBox ("请先选中一块多行包含文字的区域")
        GoTo LastLine
     End If

    j = 0

    For i = lnLastRow To 1 Step -1
        If Application.CountA(rnArea.Rows(i)) = 0 Then
            rnArea.Rows(i).Delete
            j = j + 1
        End If
    Next i

    If (lnLastRow - j) > 0 Then
        rnArea.Resize(lnLastRow - j).Select
    End If
   
    Application.ScreenUpdating = True
   
LastLine:

End Sub
'删除所选区空列
Sub Delete_Empty_Columns()
    Dim lnLastColumn As Long, i As Long, j As Long
    Dim rnArea As Range

    Application.ScreenUpdating = False
    lnLastColumn = Selection.Columns.Count
    Set rnArea = Selection

    If rnArea.Columns.Count <= 1 Then
            MsgBox ("请先选中一块多列包含文字的区域")
            GoTo LastLine
     End If
     
    j = 0

    For i = lnLastColumn To 1 Step -1
        If Application.CountA(rnArea.Columns(i)) = 0 Then
            rnArea.Columns(i).Delete
            j = j + 1
        End If
    Next i
   
    If (lnLastColumn - j) > 0 Then
        rnArea.Resize(, lnLastColumn - j).Select
    End If

    Application.ScreenUpdating = False
   
LastLine:

End Sub
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

表格智创网

网站简介:表格智创网,是一家以表格设计和技能分享的专业社区,由会计帮帮网投资建设,尽专业,助提高专业技能。

表格智创网欢迎您!

联系我们

  • 工作时间:早上9:00-16:00
  • 客服电话:18668755857
  • 本站网址:www.excelwps.com
  • 淘宝店址:kjbbw.taobao.com

Powered by Discuz! X3.4 © 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表