Excel VBA 巧妙利用错误判断数组是否为空/文件拆分工具更新

本文于2023年7月23日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！

内容提要

• 自定义函数：IsArrEmpty 判断数组是否为空
• 文件拆分工具更新

大家好，我是冷水泡茶，今天有粉丝朋友反映文件拆分工具在没有日期列的情况下无法保存工作簿？

我心想，这不会吧？

随后打开电脑，把模拟拆分文件中的日期、数值列都删除，然后测试了一下，果然没有保存文件，增加的EXCEL工作簿都是在打开状态。

但是如果输出到WORD就没有问题，So, Why?

经过一番折腾，问题最终是解决了，我也回复了粉丝的留言，但由于留言字数限制，分了好几条，看上去不是很清楚，另外，觉得可能大家很少会回过头去看留言，所以决定还是写一篇小文吧，讲得清楚一点，希望能帮到你：

解决过程

1、通过分析，应该是保存到EXCEL文件的过程（SaveToExcel）有问题，但没有报错，这是为什么？

原来，我们在导出过程中，添加了On Error Resume Next语句，有它在，有错他也不报，直接往下走。于是把它先注释掉。

2、发现有错了：

 For j = LBound(arrNumColFields) To UBound(arrNumColFields)

这里提示下标越界，于是明白了，如果没有数字列，这里的数组arrNumColFields是空的，所以报错。

3、如何解决呢？

很简单，判断一下数组是不是为空，为空则不执行这段设置单元格格式的For循环，下面的arrDateColFields也一样

4、增加一个自定义函数，再作一个数组是否为空的判断，把代码修改如下：

Sub SaveToExcel，Sub IsArrEmpty

Sub SaveToExcel()
    Dim rng As Range, col As Range
    '原来导出的是word文件，扩展名改一下
    fileName = Replace(fileName, ".docx", ".xlsx")
    Workbooks.Add
    With ActiveWorkbook
        If Me.CkbTitle Then
            .Sheets(1).Range(Cells(1, 1), Cells(1, UBound(arrTem, 1) + 1)).MergeCells = True
            .Sheets(1).Range("A1") = Me.TxbTitle
            .Sheets(1).Range("A1").HorizontalAlignment = xlCenter
            Set rng = .Sheets(1).Range("A2").Resize(UBound(arrTem, 2) + 1, UBound(arrTem, 1) + 1)
        Else
            Set rng = .Sheets(1).Range("A1").Resize(UBound(arrTem, 2) + 1, UBound(arrTem, 1) + 1)
        End If
        rng.NumberFormat = "@"
        rng = Application.WorksheetFunction.Transpose(arrTem)
        For I = 1 To rng.Columns.Count
            If Not IsArrEmpty(arrNumColFields) Then
                For j = LBound(arrNumColFields) To UBound(arrNumColFields)
                    If rng.Cells(1, I).Value = arrNumColFields(j) Then
                        Set col = rng.Columns(I)
                        col.NumberFormatLocal = "_ * #,##0.00_ ;_ * -#,##0.00_ ;_ * ""-""??_ ;_ @_ "
                        col.Value = col.Value
                    End If
                Next
            End If
            If Not IsArrEmpty(arrDateColFields) Then
                For j = LBound(arrDateColFields) To UBound(arrDateColFields)
                    If rng.Cells(1, I).Value = arrDateColFields(j) Then
                        Set col = rng.Columns(I)
                        col.NumberFormatLocal = "yyyy/m/d"
                        col.Value = col.Value
                    End If
                Next
            End If
        Next
        rng.Columns.AutoFit
        .SaveAs fileName:=saveFolder & "\" & fileName
        .Close
    End With
End Sub
Function IsArrEmpty(ByVal sArray As Variant) As Boolean '判断数组是否为空
    Dim I As Long
    IsArrEmpty = False
    On Error GoTo ErrorHandler:
    I = UBound(sArray)
    Exit Function
ErrorHandler:
    IsArrEmpty = True
End Function

代码解析：

1、line18：判断arrNumColFields是否为空，如果不为空，就执行下面的For循环设置数值列的单元格格式，否则就跳过。

2、line27：判断arrDateColFields是否为空，如果不为空，就执行下面的For循环设置日期列的单元格格式，否则就跳过。

3、line42~50：自定义函数，判断数组是否为空。方法是取数组最大下标，如果数组为空，则会报错，如果报错就跳到ErrorHandler，继续运行，函数值为TRUE；如果数组不为空，则不会报错，退出函数，函数的值为False（在函数开始就设定了函数值为False，IsArrEmpty = False。其实这句也可以不要，对于Boolean类型的变量，默认值就是FALSE。

其他

1、修正了连续打开文件时，选择工作表下拉列表仍存有上次文件的工作表信息，方法是在添加列表项目前，先把CmbSheets的list清空。

2、清空CmbSheets的list又触发了CmbSheets的Change事件，由于CmbSheets等于空，又报错。

3、于是，在Sub CmbSheets_Change过程开头添加一句代码，问题解决，目前运行正常。

    If Me.CmbSheets = "" Then Exit Sub

正文完

喜欢就点个赞、点在看、留个言呗！

本文于2023年7月23日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！