class - Excel VBA 中 Match 的错误处理

Question

我调用了 VBA class 来获取工作表中所需列的列号（其中 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

使用字典

如果您不希望代码中出现所有重复，您可能希望使用字典来存储列 names/numbers。

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

class - Excel VBA 中 Match 的错误处理

Error handling for Match inside a class - Excel VBA

excel

vba

match

原始代码已更新

使用字典

使用从函数填充的字典