excel - 类内匹配的错误处理 - Excel VBA

Question

我有一个 VBA 类，我调用它来获取工作表中所需列的列号(其中 15 个)。允许用户移动列并且匹配功能运行良好。但是，如果用户删除列，我会收到运行时错误。如何捕获错误并让用户知道“X”列名已被删除但仍继续检查其余列。

Option Explicit
Public EmpName As Long, EmpID As Long, EmpDepartment As Long, EmpAddress As Long

Private Sub Class_Initialize()
Dim ws As Worksheet, r As Range, tStr As String, wsname As String
Set ws = ActiveSheet:   Set r = ws.Range("1:1")

EmpName = Application.WorksheetFunction.Match("EmpName", r.value, 0)
EmpID = Application.WorksheetFunction.Match("EmpID", r.value, 0)
EmpDepartment = Application.WorksheetFunction.Match("EmpDepartment", r.value, 0)
EmpAddress = Application.WorksheetFunction.Match("EmpAddress", r.value, 0)

Set r = Nothing: Set ws = Nothing
End Sub

Answer 1

原始代码已更新
为避免运行时错误，您可以使用 Application.Match而不是 Application.WorksheetFunction.Match .

Option Explicit
Public EmpName As Long, EmpID As Long, EmpDepartment As Long, EmpAddress As Long

Private Sub Class_Initialize()
Dim ws As Worksheet, r As Range, tStr As String, wsname As String
Dim Res As Variant

    Set ws = ActiveSheet
    Set r = ws.Range("1:1")
    
    Res = Application.Match("EmpName", r.Value, 0)
    If Not IsError(Res) Then
        EmpName = Res
    Else
        MsgBox "EmpName column not found!", vbInformation, "Missing Column"
    End If
    
    Res = Application.Match("EmpID", r.Value, 0)
    If Not IsError(Res) Then
        EmpID = Res
    Else
        MsgBox "EmpID column not found!", vbInformation, "Missing Column"
    End If
    
    Res = Application.Match("EmpDepartment", r.Value, 0)
    If Not IsError(Res) Then
        EmpName = Res
    Else
        MsgBox "EmpDepartment column not found!", vbInformation, "Missing Column"
    End If
    
    Res = Application.Match("EmpAddress", r.Value, 0)
    If Not IsError(Res) Then
        EmpAddress = Res
    Else
        MsgBox "EmpAddress column not found!", vbInformation, "Missing Column"
    End If

End Sub

使用字典
如果您不希望代码中的所有重复，您可能希望查看使用字典来存储列名/编号。

Option Explicit

Private Sub Class_Initialize()
Dim ws As Worksheet, r As Range, tStr As String, wsname As String
Dim dicCols As Object
Dim arrCols As Variant
Dim Res As Variant
Dim idx As Long

    arrCols = Array("EmpName", "EmpID", "EmpDepartmen", "EmpAddress")

    Set dicCols = CreateObject("Scripting.Dictionary")

    Set ws = ActiveSheet
    Set r = ws.Range("1:1")

    For idx = LBound(arrCols) To UBound(arrCols)
        Res = Application.Match(arrCols(idx), r.Value, 0)
        If Not IsError(Res) Then
            dicCols(arrCols(idx)) = Res
        Else
            dicCols(arrCols(idx)) = "Not Found"
            MsgBox arrCols(idx) & " column not found!", vbInformation, "Missing Column"
        End If
    Next idx

End Sub

执行此代码后，您可以使用 dicCols(ColumnName)获取列号。
例如，无论您在何处引用变量 EmpName在其余代码中，您可以使用 dicCols("EmpName") .
使用从函数填充的字典
另一个改进可能是使用函数来创建字典。
这将允许您在需要时传递不同的列名集。

Option Explicit
Public dicCols As Object

Private Sub Class_Initialize()
Dim ws As Worksheet, r As Range, tStr As String, wsname As String
Dim arrColNames As Variant
Dim arrNotFound() As Variant
Dim ky As Variant
Dim cnt As Long

    arrColNames = Array("EmpName", "EmpID", "EmpDepartment", "EmpAddress")

    Set ws = ActiveSheet
    Set r = ws.Range("1:1")

    Set dicCols = GetColNos(arrColNames, r)

    For Each ky In dicCols.keys
        If dicCols(ky) = "Not Found" Then
            cnt = cnt + 1
            ReDim Preserve arrNotFound(1 To cnt)
            arrNotFound(cnt) = ky
        End If
    Next ky
    
    If cnt > 0 Then
        MsgBox "The following columns were not found:" & vbCrLf & vbCrLf & Join(arrNotFound, vbCrLf), vbInformation, "Missing Columna"
    End If
    
End Sub

Function GetColNos(arrColNames, rngHdr As Range) As Object
Dim dic As Object
Dim idx As Long
Dim Res As Variant

    Set dic = CreateObject("Scripting.Dictionary")
    
    For idx = LBound(arrColNames) To UBound(arrColNames)
        Res = Application.Match(arrColNames(idx), rngHdr.Value, 0)
        If Not IsError(Res) Then
            dic(arrColNames(idx)) = Res
        Else
            dic(arrColNames(idx)) = "Not Found"
        End If
    Next idx

    Set GetColNos = dic
    
End Function