本文于2023年9月22日首发于本人同名其他平台。
内容提要
代码更正与优化
大家好，我是冷水泡茶，9月4日我们分享过一个案例【Excel VBA 批量自动生成应收款对账单/应付通知单】，很“不幸地”，代码中有重大错漏：
于是，我打开原文件，把一个法人的记录删掉一些，保留2行，
运行，结果让我头皮一阵发麻，没有数据啊，而且法人的名称也不对：
赶紧检查代码，发现问题出在这里：
If语句少了一个Else，只处理了需要增加行的情况，如果不需要增加行，则没有处理，没有把数据写入工作表。
问题找出来了，但具体怎么改呢？
我们可以增加一个Else分支，把不需要增加行的操作处理一下，可以直接复制上面的代码，把插入行的代码删掉，应该就可以了。
但转念一想，我们用IF判断extraLines的值，是为了插入行，那么向工作表写入数据的操作可以在IF判断完成后再执行。比如，我们可以改成下面的形式，只是把原来代码的顺序调一调：
With wsTarget If extraLines > 0 Then .Rows(tbFirstLine + 1 & ":" & tbFirstLine + extraLines).Insert Shift:=xlDown .Rows(tbFirstLine2 + 1 + extraLines & ":" & tbFirstLine2 + extraLines + extraLines).Insert Shift:=xlDown End If .Range("B3") = Key .Range("A5") = Me.CmbCurrentMonth .Range("F5") = Me.CmbDeadLine .Cells(tbFirstLine, 2).Resize(UBound(arr1), UBound(arr1, 2)) = arr1 .Cells(tbFirstLine2 + extraLines, 2).Resize(UBound(arr2), UBound(arr2, 2)) = arr2 For j = 1 To dic(Key) .Cells(tbFirstLine + j - 1, 1) = j .Cells(tbFirstLine2 + extraLines + j - 1, 1) = j Next memoLine = tbLastLine2 + 4 + IIf(extraLines > 0, extraLines * 2, 0) .Cells(memoLine, 1) = "请各位法人于" & Me.CmbCurrentMonth & "缴完应付额" End IfEnd With
即，如果需要插入行，则先插入行后再写入数据。如果不需要插入行，那么就跳过插入行的代码，直接写入数据。
但是问题又来了，在下面写入数据的代码中，计算定位数据行时，加上了extraLines， 原来是应用于需要增加行的情况的，对于不需要增行的，应该把这个变量去掉。难道我们需要再来一次判断？先别急着改，我们再来分析分析：
对于不需要插入行的情况有两种，一种正好是3行，extraLines=0，另一种是1行或2行，extraLines的值为负数。
如果extraLines正好等于0，那么代码运行结果应该是正确的，加上0还等于原来的数。如果是负数就不行了。
那么，如果extraLines为负数时，我们到底应该怎么办呢？
别看我啰里啰嗦了一大堆，其实这里的解决方法很简单，如果extraLines不大于0，我们就把它统统改为0。这里有两个地方可以处理它：
1、在计算extraLines的时候
extraLines = UBound(arr1) - (tbLastLine - tbFirstLine + 1)
我们可以用IIF函数来处理它，可以在“=”号的右边处理，但代码太长，我们可以在上一行代码下面加一行代码：
extraLines = IIf(extraLines > 0, extraLines, 0)
2、在判断extraLines是否大于0的时候，我们加一句Else：extraLines = 0
If extraLines > 0 Then .Rows(tbFirstLine + 1 & ":" & tbFirstLine + extraLines).Insert Shift:=xlDown .Rows(tbFirstLine2 + 1 + extraLines & ":" & tbFirstLine2 + extraLines + extraLines).Insert Shift:=xlDownElse extraLines = 0End If
这样，接下来把数据从数组中写入工作表就没有问题了。
不过，问题并没有完全按上面的思路执行。
我选的是按第2种方法来处理extraLines的值，但我在修改代码的时候发现，有好几处代码块功能相同，都需要修改，感觉非常不爽，后来干脆把这段写入工作表的代码单独为一个过程：WriteData
Sub WriteData(ws As Worksheet) '把数据写入工作表 With ws If extraLines > 0 Then .Rows(tbFirstLine + 1 & ":" & tbFirstLine + extraLines).Insert Shift:=xlDown .Rows(tbFirstLine2 + 1 + extraLines & ":" & tbFirstLine2 + extraLines + extraLines).Insert Shift:=xlDown Else extraLines = 0 End If .Range("B3") = Key .Range("A5") = Me.CmbCurrentMonth .Range("F5") = Me.CmbDeadLine .Cells(tbFirstLine, 1).Resize(UBound(arr1), UBound(arr1, 2)) = arr1 .Cells(tbFirstLine2 + extraLines, 1).Resize(UBound(arr2), UBound(arr2, 2)) = arr2 memoLine = tbLastLine2 + 4 + extraLines * 2 .Cells(memoLine, 1) = "请各位法人于" & Me.CmbCurrentMonth & "缴完应付额" End WithEnd Sub
当然，我们要把extraLines，Key定义到过程外面去，把它们变成公众变量，或者作为上面独立过程的参数。
后来，发现生成的序号好象也有问题，也作了修改，直接使用变量k的值。又发现这样的代码有2处一模一样的，干脆也独立为一个过程吧：
Sub WriteArray(arr1(), arr2()) ReDim arr1(1 To dic(fileName), 1 To 13) ReDim arr2(1 To dic(fileName), 1 To 4) For i = 2 To UBound(arrDetail) If arrDetail(i, 1) = fileName Then k = k + 1 For m = 2 To 13 arr1(k, m) = arrDetail(i, m) Next arr1(k, 1) = k arr2(k, 1) = k arr2(k, 2) = arrDetail(i, 2) arr2(k, 3) = arrDetail(i, 14) arr2(k, 4) = arrDetail(i, 15) End If NextEnd Sub
另外，在生成独立文件的时候，有一张空白的表格“Sheet"，看着碍眼，删了它！
For Each ws In wb.Worksheets If ws.Name <> Key Then ws.Delete End IfNext
这下清爽多了。测试一下，没有问题。收工！
更新后的完整代码我放到第二条文章吧，感兴趣朋友可以去看一看。或者，跟以前的代码比较比较，捋一捋这里面的逻辑关系，我想，如果是想学VBA，花这点功夫应该是值得的。
写到最后，我想起来，我应该向大家说声抱歉！ 以后要多测试、多检查，提高代码质量！
今天是周末，祝大家周末愉快！（好象上个周末我们也是更正代码的，这难道仅仅是巧合？）
~~~~~~End~~~~~~
喜欢就点个赞、点在看、留言评论、分享一下呗！感谢支持！