Excel VBA Application.Match 错误处理和消息传递答案

【问题标题】：Excel VBA Application.Match error handling and messagingExcel VBA Application.Match 错误处理和消息传递
【发布时间】：2017-02-22 08:52:10
【问题描述】：

我正在尝试将 Excel sheet 中的数据存储到 array 中。数据如下所示：

我使用的代码：

Sub StoreData()

Dim Data() As String

'Count number of Line in Sheet1
Sheet1_size = Worksheets("Sheet1").Range("A1").CurrentRegion.Rows.Count

'Array to store data
ReDim Data(1 To Sheet1_size - 1, 1 To 6) As String

'storing data into array
For i = 1 To Sheet1_size - 1

    With Worksheets("Sheet1")

         Data(i, 1) = .Cells(i + 1, Application.Match("Name", .Rows(1), 0))
         Data(i, 2) = .Cells(i + 1, Application.Match("Sex", .Rows(1), 0))
         Data(i, 3) = .Cells(i + 1, Application.Match("Age", .Rows(1), 0))
         Data(i, 4) = .Cells(i + 1, Application.Match("Nationality", .Rows(1), 0))
         Data(i, 5) = .Cells(i + 1, Application.Match("License", .Rows(1), 0))
         Data(i, 6) = .Cells(i + 1, Application.Match("Hand", .Rows(1), 0))

    End With
Next i

End Sub

当sheet1 看起来像上面时，一切都完美无缺。

但是，sheet1 中每次的列顺序和数量可能不同。例如它可能是：Name Age Nationality 或 Name License Hand Sex Age Nationality 或 Nationality Age 等。此表由人们填写，因此他们可能会忘记包含一些变量。

如果缺少任何列，我会在下面收到 error：

我想要显示message/message box 缺少列的名称而不是此错误。如果有几个缺失的列，我想向所有缺失的名称发送消息。

禁用错误不是解决方案，因为屏幕上没有消息传递。有什么解决办法吗？

【问题讨论】：

只Dim Data As Variant然后设置Data = Worksheets("Sheet1").Range("A1").CurrentRegion不是更容易吗？
数组中变量的位置必须固定。此外，这并不能解决如何向用户发送有关缺失列的消息

标签： vba excel error-handling match

【解决方案1】：

这是我建议的解决方案：

Option Explicit
Option Compare Text

Public Sub StoreData()

Dim ws As Worksheet
Dim Data As Variant
Dim LastRow As Long, LastColumn As Long
Dim nColumn As Long, RequirementCount As Long, CheckCount As Long
Dim RequirementList() As String, ErrorMessage As String

'Determine the range
Set ws = ThisWorkbook.Worksheets("Sheet1")
LastRow = ws.Cells.Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastColumn = ws.Cells.Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Row
'Range to array
Data = ws.Range(ws.Cells(1, 1), ws.Cells(LastRow, LastColumn)).Value2

'Set requirements
RequirementList = Split("Name|Nationality|Age|License|Hand|Sex", "|")

'Compare all available columns against the requirements
For nColumn = 1 To UBound(Data, 2)
    For RequirementCount = LBound(RequirementList) To UBound(RequirementList)
        If Data(1, nColumn) = RequirementList(RequirementCount) Then
            RequirementList(RequirementCount) = vbNullString
            CheckCount = CheckCount + 1
        End If
    Next RequirementCount
Next nColumn

'If less then the required 6 columns were found then pass a message box to the user telling him/her about it
If CheckCount <> 6 Then
    ErrorMessage = "The following columns are missing:" & Chr(10)
    For RequirementCount = LBound(RequirementList) To UBound(RequirementList)
        ErrorMessage = ErrorMessage & IIf(RequirementList(RequirementCount) = vbNullString, "", "   -" & RequirementList(RequirementCount) & Chr(10))
    Next RequirementCount
    MsgBox ErrorMessage
Else
    MsgBox "All columns are accounted for and ready for import."
End If

End Sub

查看代码中的 cmets 了解更多信息。另外，请注意代码顶部Option Compare Text 的重要性，以确保Age = age = aGe 等。

【讨论】：