2000字范文,分享全网优秀范文,学习好帮手!
2000字范文 > 实现Excel行插入行删除特殊处理 单元格合并及动态条件单元格公式自动计算功能的VBA

实现Excel行插入行删除特殊处理 单元格合并及动态条件单元格公式自动计算功能的VBA

时间:2024-06-05 12:32:14

相关推荐

实现Excel行插入行删除特殊处理 单元格合并及动态条件单元格公式自动计算功能的VBA

最近的项目中,用到了很多Excel的VBA宏功能,用户的新需求也有很多需要用VBA宏来实现。为满足业务需求,

自己搜索网上的相关资料,尝试不同的解决方法,最终解决了用户的需求,在此记录下来,做一个总结,也希望能给

别的网友有所帮助。

首先用户的第一个需求,是Excel WorkSheet中原有的行不可删除,只能修改某些栏位。用户可以新插入行,而新插入

的行可以删除。如下图所示:

2001,2002,和四行数据 不允许删除,而Inserted这行数据是后来插入的,可以删除。

Excel可以整个sheet锁定,却没有按行锁定,而且即使能按行锁定,由于存在插入删除,行序会动态变化,

锁定位置也无法固定。所以必须用锁定以外的方法来解决。

首先想到的就是监听Worksheet的插入和删除事件。如果插入删除都有响应事件,那在事件中做拦截处理就

很容易实现功能了。可惜的是,Excel虽然功能无比强大,但是worksheet的响应事件却并不丰富,仅有一个change

事件,能响应所有的worksheet中改变内容的操作,其他事件似乎都不太有用:

还好,在网上搜到了在这个事件中判断整行插入和删除的方法:

'选择了一整行

If Target.Address Like "$#*:$#*" Then

但是这只能判断出是整行选择,至于是插入还是删除,就得自己去区别处理了。

插入比较简单,Target.row所指向的是一个空行,而且已经存在于Excel中了,所以直接判断第一个单元格为空就好:

'如果TargetRow的第一列值为空,且不是最后一行,说明是插入

'Sheet1.UsedRange.Row 表示有数据的开始行序,Sheet1.UsedRange.Rows.Count 表示有数据的行数,二者相加就是最后一行序

If (Trim(Sheet1.Cells(Target.Row, 1).Value) = "" And _

Target.Row <> (Sheet1.UsedRange.Row + Sheet1.UsedRange.Rows.Count)) Then

之所以要区分是否最后一行,因为在最后一行插入时,插入前选中的行也就是插入位置本身就是空行,而在其他位置插入,

插入位置不是空行,所以需要特别区分。

而删除操作就比较麻烦,因为Worksheet_change的Target参数中,没有任何关于被删除行的信息,而且当事件发生时,删除行

已经从Excel中移除,Target.row指向的是一个新行。所以就需要提前把删除行的信息在选择事件中记录下来:

'在Slection change 事件中,保存选择的行号和第一列的值

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

selectedRow = Target.Row

selectedId = Sheet1.Cells(Target.Row, 1).Value

End Sub

这样,在change事件中,就可以取得删除行的selectedId,如果是新插入的数据,第一列值就是Inserted,可以删除;否则,就是

原有的数据,不允许删除:

当然,要完整实现用户功能,还需要增加一些完善措施,例如多行选中的剔除:

'如果选择多于一行

If (Selection.Rows.Count > 1) Then

MsgBox "Only allowed select one row"

Application.Undo

Else

还有禁止首行插入,首列标记的约定等。具体可以看实现代码。

第二个需求是插入单元格后,能自动合并。如下图所示:

插入新城市之后,省份要自动合并。这里,继续沿用上面的方法,在Worksheet的change事件中,进行处理:

这里只处理了插入行的合并,对于删除行需要的合并,可以参照第一个需求,采用首列标记的做法来区别处理。

合并单元格时,需要区分插入的位置,合并单元格中间插入的,无需合并;合并单元格末尾插入的,需要调整

合并单元格大小;而在整个表格最后插入的,除了调整合并单元格大小外,还需要绘制边框。

这里引用到了在模块中定义的三个方法:findLastRow 找到当前数据的最后一行,findPrevMerge 找到需要合并

的单元格,setRangeBorder 设置Range的边框:

第三个需求,是需要设定单元格的条件公式自动计算。具体如下图所示:

支出部分各个项目的值,要根据相应的收入部分,按比例拆分。例如,对于01列,项目1的支出应该是1500 *

1000 /(1000+900+1500)。02没有收入,就按收入总额的占比进行拆分,所以项目1在02的支出应该是3000*3000/

(3000+2000+5000)。上部分收入数据发生改变后,下部分支出数据要自动拆分,所以决定用单元格的宏公式来实现。

首先定义一个方法:

'设置Sheet3的动态公式

Sub setDynamicFormula()

当然,需要先定义一个公用方法findNext,去找到收入和支出合并单元格的range,后面设定公式时,会用到这两个

range对象。

获取收入的range后,可以拼出汇总total收入和当期收入的公式:

Set revRng = findNext(Sheet3, categoryCol, titleRow + 1, "收入")

'汇总Total的公式

sumTotal = "SUM(R" & revRng.Row & "C" & totalCol & ":R" & (revRng.Row + revRng.Rows.Count - 1) & "C" & totalCol & ")"

'汇总收入的公式

sumRev = "SUM(R" & revRng.Row & "C:R" & (revRng.Row + revRng.Rows.Count - 1) & "C)"

汇总Total收入,指定的行是收入Range的所有行,列是收入Total所在列,都是绝对引用。

汇总当期收入,行一样,列只有C,意味着取要设定公式的单元格的列。

最后,循环对支出Range所在行的所有期间列的支出单元格,设定计算公式:

For i = totalCol + 1 To Sheet3.UsedRange.Column + Sheet3.UsedRange.Columns.Count - 1

For j = 0 To costRng.Rows.Count - 1

Sheet3.Cells(costRng.Row + j, i).NumberFormatLocal = "#######.00" '保留两位小数

'如果当前收入为空或为0,采用总收入占比拆分,否则用当前收入占比拆分

Sheet3.Cells(costRng.Row + j, i).FormulaR1C1 = "=IF(OR(R[-" & rowOffset & "]C="""",R[-" & rowOffset & "]C=0)," & _

"R[-" & rowOffset & "]C" & totalCol & "/" & sumTotal & "*R" & totalCostRow & "C," & _

"R" & totalCostRow & "C*R[-" & rowOffset & "]C/" & sumRev & ")"

Sheet3.Cells(costRng.Row + j, i).Locked = True

Next j

Next i

在这里,当前期收入的行,采用的是相对引用,当前收入的列,直接采用单元格的值,而totalCost的行,及total收入的列,

则都采用的绝对引用。

最后,把setDynamicFormula()方法加入到workbook的open事件中,当Excel打开时,就会自动实现单元格计算公式的赋值。

示例Excel宏文件已经上传CSDN:/download/yangdanbo1975/10205254

由于本人是第一次搞VBA宏,水平有限,如有不妥或不完善之处,还欢迎各位网友不吝赐教,以利共同提高。



实现Excel行插入行删除特殊处理 单元格合并及动态条件单元格公式自动计算功能的VBA 宏示例

本内容不代表本网观点和政治立场,如有侵犯你的权益请联系我们处理。
网友评论
网友评论仅供其表达个人看法,并不表明网站立场。