1

我正在尝试使用以下代码验证用户上传的文件。错误处理程序检查上传文件的顶行是否有三个特定的列名。如果一个或多个列名不存在，程序应向用户返回提示，通知他们上传的文件中缺少哪些列，然后关闭文件。

我正在寻求帮助的当前 VBA 代码存在几个问题：

  1. 提示未指定用户缺少哪些列。
  2. 即使上传的文件中存在所有必需的列，也会触发错误处理程序。

代码：

Sub getworkbook()
' Get workbook...
    Dim ws As Worksheet
    Dim filter As String
    Dim targetWorkbook As Workbook, wb As Workbook
    Dim Ret As Variant

    Set targetWorkbook = Application.ActiveWorkbook

    ' get the customer workbook
    filter = ".xlsx,.xls"
    caption = "Please select an input file "
    Ret = Application.GetOpenFilename(filter, , caption)

    If Ret = False Then Exit Sub

    Set wb = Workbooks.Open(Ret)

On Error GoTo ErrorLine:

'Check for columns
var1 = ActiveSheet.Range("1:1").Find("variable1", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True).Column
var2 = ActiveSheet.Range("1:1").Find("variable2", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True).Column
var3 = ActiveSheet.Range("1:1").Find("variable3", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True).Column

ErrorLine: MsgBox ("The selected file is missing a key data column, please upload a correctly formated file.")
If Error = True Then ActiveWorkSheet.Close

wb.Sheets(1).Move Before:=targetWorkbook.Sheets("Worksheet2")
    ActiveSheet.Name = "DATA"

End Sub
4

3 回答 3

3

这个AME怎么样。应该做你想做的一切，并提醒用户哪些数据列丢失了。此外，不需要GoTo声明。只是一个简单的If Then Else

Sub getworkbook()
' Get workbook...
    Dim ws As Worksheet
    Dim filter As String
    Dim targetWorkbook As Workbook, wb As Workbook
    Dim Ret As Variant

    Set targetWorkbook = Application.ActiveWorkbook

    ' get the customer workbook
    filter = ".xlsx,.xls"
    Caption = "Please select an input file "
    Ret = Application.GetOpenFilename(filter, , Caption)

    If Ret = False Then Exit Sub

    Set wb = Workbooks.Open(Ret)

    'Check for columns
    Dim var1 As Range, var2 As Range, var3 As Range
    Set var1 = ActiveSheet.Range("1:1").Find("variable1", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True).Column
    Set var2 = ActiveSheet.Range("1:1").Find("variable2", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True).Column
    Set var3 = ActiveSheet.Range("1:1").Find("variable3", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True).Column

    If Not var1 Is Nothing Or Not var2 Is Nothing Or Not var3 Is Nothing Then

        wb.Sheets(1).Move Before:=targetWorkbook.Sheets("Worksheet2")
        ActiveSheet.Name = "DATA"

    Else

       MsgBox "The selected file is missing the following key data column(s): " & _
        vbNewLine & _
        vbNewLine & _
        IIf(var1 Is Nothing, "variable1", "") & _
        IIf(var2 Is Nothing, "variable2", "") & _
        IIf(var3 Is Nothing, "variable3", "") & _
        vbNewLine & _
        "Please upload a correctly formated file."

        ActiveWorkbook.Close False

    End If

End Sub
于 2012-09-24T20:45:09.730 回答
0

看看这是不是你想要的

Sub getworkbook()
    ' Get workbook...
    Dim ws As Worksheet
    Dim filter As String
    Dim targetWorkbook As Workbook, wb As Workbook
    Dim Ret As Variant

    Set targetWorkbook = Application.ActiveWorkbook

    ' get the customer workbook
    filter = ".xlsx,.xls"
    Caption = "Please select an input file "
    Ret = Application.GetOpenFilename(filter, , Caption)

    If Ret = False Then Exit Sub

    Set wb = Workbooks.Open(Ret)



'Check the headers in first row
Dim width As Long
Dim var1 As Long, var2 As Long, var3 As Long
With ActiveSheet
    width = .Cells(1, .Columns.Count).End(xlToLeft).Column ' getting the non-empty columns from right to left scanning
    ' var1,2,3 will store the column number contains variable1,2,3
    var1 = -1
    var2 = -1
    var3 = -1
    For j = 1 To width
        If .Cells(1, j).Value = "variable1" Then
            var1 = j
        ElseIf .Cells(1, j).Value = "variable2" Then
            var2 = j
        ElseIf .Cells(1, j).Value = "variable3" Then
            var3 = j
        End If
    Next j


    If var1 = -1 Then
        MsgBox "variable1 not found"
    End If
    If var2 = -1 Then
        MsgBox "variable2 not found"
    End If
    If var3 = -1 Then
        MsgBox "variable3 not found"
    End If
End With


wb.Sheets(1).Move Before:=targetWorkbook.Sheets("Worksheet2")
    ActiveSheet.Name = "DATA"

End Sub
于 2012-09-25T00:52:45.993 回答
-1

如果没有发生错误，您必须明确结束 Sub 处理，在块声明Exit Sub之前放置一条语句。ErrorLine它应该解决不希望的触发问题。

于 2012-09-24T20:32:05.823 回答