VSTO插件功能介绍-清除空行【进化过程】

哆哆Excel

发布于 2024-07-12 18:53:38

460

发布于 2024-07-12 18:53:38

文章被收录于专栏：哆哆Excel

大家看到的是完成的成果，

可能不知在其中，写码人的艰辛

今天的主要是记录【进化过程】

用于自勉，与大家共勉，努力

文章中的代码你可复制使用哦

想要的效果
若用户选择了区域，选择确定Button对此区域，进行清除空行若用户想要本表所用区域，选择取消Button，对本表所用区域，进行清除空行

思路
1. 出现对话框，用户选择区域，选择Button2. 判断用户是否选择，如果不选择，就赋值Usedrange,如果选择但行数<2行（此时用户是鼠标点在一个单元格中）赋值Usedrange，如果行数>2行，说明用户是做了选择区域啦赋值SelectRngs3. 下面要运行判断，计算行如果数据CountA=0,删除行，否则不删除

【第一版本】

'清除空行
PublicSub DeleteEmptyRowsInSelection()
Dim ActSht As Excel.Worksheet = xlapp.ActiveSheet
Dim UsedRngs As Excel.Range = ActSht.UsedRange
Dim rngs As Excel.Range
Dim oneRng As Excel.Range
Dim r AsInteger
Dim startRow AsInteger
Dim endRow AsInteger
'Dim SelectRngs As Excel.Range
On ErrorResumeNext
Dim SelectRngs As Excel.Range = xlapp.InputBox(Prompt:="选择区域:"+ vbCrLf +"1.选择、确定=你选择区域"+ vbCrLf +"2.取消=默认是本表所用区域"， Title:="请选择",Default:=xlapp.Selection.address,Type:=8)
On ErrorGoTo0
If IsNothing(SelectRngs)Then
            rngs = UsedRngs
Else
If SelectRngs.Rows.Count <2Then
                rngs = UsedRngs
Else
                rngs = SelectRngs
EndIf
EndIf' 检查选择区域是否为空
'第1版本：(这种有点问题，特别是两个空行时)
For Each oneRng In rngs.Rows
If xlapp.Application.WorksheetFunction.CountA(oneRng)=0Then
' 如果没有数据，删除该行
                oneRng.EntireRow.Delete()
'oneRng.EntireRow.Interior.ColorIndex = 20
EndIf
Next
EndSub

【出现问题】

【第2版本】第2版本

With ActSht
'获取选择区域的开始和结束行号
            startRow = rngs.Row
            endRow = startRow + rngs.Rows.Count -1
' 从最后一行开始向上遍历，避免索引问题
For r = endRow To startRow Step-1
' 检查整行是否有数据
If xlapp.Application.WorksheetFunction.CountA(rngs.Rows(r - startRow +1))=0Then
' 如果没有数据，删除该行
                    .Rows(r).Delete
EndIf
Next r
EndWith
EndSub

【第2-1版本】

.CountA(rngs.CountA(rngs.Rows(r))=0

【出现问题】

一开始也不知出现在那里

后来用这个

MsgBox(.Address + "-" + r.ToString() + "-" + .Rows(r).Address)

输出相关的内容，进行检测，才能看到问题所在

后有修改成以下情况

【第2-2版本】

.CountA(rngs.CountA(rngs.Rows(r - startRow +1))=0

可以进行正确的删除

【出现问题】

因为在WithActSht中运行，所以删除是本表的行，

如果区域内的删除，就会出错连带也删除了外部的数据

【第3版本】

'第3版本
With rngs
'获取选择区域的开始和结束行号
            TotalRows = .Rows.Count
' 从最后一行开始向上遍历，避免索引问题
For r = TotalRows To1Step-1
' 检查整行是否有数据
                MsgBox(.Address +"-"+ r.ToString()+"-"+ .Rows(r).Address)
If xlapp.Application.WorksheetFunction.CountA(.Rows(r))=0Then
' 如果没有数据，删除该行
                    .Rows(r).Delete
EndIf
Next r
EndWith

在本区域中运行，不影响外部，

先计算区域的总行数，

从最大行开始逆序计算，若为CountA=0,删除本区域

完成

==提示==

插件命名：“哆哆Excel”，日前没打包，

主要是自用，提高工作效率

大部分代码，请看历史文章