1

以下のコードを使用して、ユーザーがアップロードしたファイルを検証しようとしています。エラー ハンドラーは、アップロードされたファイルの一番上の行で 3 つの特定の列名をチェックします。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

このアメはどうですか。必要なことをすべて実行し、どのデータ列が欠落しているかをユーザーに警告する必要があります。また、申告は不要です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

ブロック宣言Exit Subの直前にステートメントを置いて、エラーが発生しなかった場合は明示的に Sub 処理を終了する必要があります。ErrorLine望ましくないトリガーの問題に対処する必要があります。

于 2012-09-24T20:32:05.823 に答える