0

空白のフィールドを検証するのに少し問題があります。

このコードを使用してファイルを開くと、ファイルが開き、その列のアプリケーション番号がチェックされます（ここでは、アプリケーション番号が最初の列にあります）

私がやろうとしているのは、アプリケーション番号が存在しない場合、「次の行番号に空白のアプリケーション番号が見つかりました」というエラーを書き出す必要があるということです。

'Global Variables

 Dim rErr As Integer

'
' Find the last used row in a Column: column A in this example
'

Function LastRowInOneColumn(ColNo As String) As Long

    Dim LastRow As Long

    With ActiveSheet
        LastRow = .Cells(.Rows.Count, ColNo).End(xlUp).Row
    End With

   LastRowInOneColumn = LastRow

End Function

'
' Find the last used column in a Row: row 1 in this example
'

Function LastColumnInOneRow(RowNo As String)

    Dim LastCol As Integer

    With ActiveSheet
        LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    End With

    LastColumnInOneRow = LastCol

    'MsgBox LastCol

End Function

'
' To Check Application Number
'

Function Check_AppNo(appNo, pRow, Lrow) As Boolean

    Check_AppNo = True

    Dim MinAppNo, MaxAppNo As Single

    MinAppNo = 0
    MaxAppNo = 9999999999#

    If (appNo < MinAppNo Or appNo > MaxAppNo) Then
        Worksheets("Error_Results").Cells(rErr, 1) = "Application number out of range at Row " & i
        rErr = rErr + 1
        Check_AppNo = False
    End If

    For j = pRow + 1 To Lrow
        If (appNo = Worksheets("Sheet1").Cells(j, 1)) Then
            Worksheets("Error_Results").Cells(rErr, 1) = "Duplicate Application numbers at Rows " & pRow & " and " & j
            rErr = rErr + 1
            Check_AppNo = False
        End If
    Next j

End Function

Function OpenFile() As String
  NewFN = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*",         Title:="Please select a file")
  If NewFN = False Then
    ' They pressed Cancel
    OpenFile = ""
    'MsgBox "Stopping because you did not select a file"
    Exit Function
  Else
    Workbooks.Open Filename:=NewFN
    iPos = InStr(1, NewFN, "\") + 1
    ipos1 = 0
    Do
        ipos1 = InStr(iPos, NewFN, "\") + 1
        If (ipos1 <> 1) Then
             iPos = ipos1
        End If
    Loop Until (ipos1 = 1)
    OpenFile = Mid(NewFN, iPos, Len(NewFN) - iPos + 1)
  End If
End Function

Sub AddWorkSheet(fName As String, sName As String)
    Dim wSheet As Worksheet
    Workbooks(fName).Activate
    On Error Resume Next
    Set wSheet = Worksheets(sName)
    If wSheet Is Nothing Then
         Worksheets.Add().Name = sName
    Else
         Worksheets(sName).Clear   
    End If
    On Error GoTo 0
End Sub

Sub validate()

    Dim fName As String
    Dim aName As String
    Dim flag As Variant

    fName = OpenFile()           ' Open the required data file

    If (fName = "") Then
        Exit Sub
    End If

    Call AddWorkSheet(fName, "Error_Results")  ' Add Error Worksheet to the data Excel File
    rErr = 1

    Worksheets("Sheet1").Select
    LastRow = LastRowInOneColumn("A")       ' Get The Last Row in Column

    For pRow = 2 To LastRow

        rerr1 = rErr

        appNo = Worksheets("Sheet1").Cells(pRow, 1)
        flag = Check_AppNo(appNo, pRow, LastRow)

    Next pRow        'Process the next Record in Error_Results WorkSheet

    Workbooks(fName).Close (True) ' Closes an opened workbook on which the validation was done

End Sub

Sub Button1_Click()

    Call validate

End Sub

次の手順に従ってコードを実行します。

  • ステップ1：最初に「abc1」という名前のExcelファイルを作成します
  • ステップ2：そのファイルの1列目に、その見出しを「アプリケーション番号」として指定します
  • ステップ3：アプリケーション番号（任意の番号）を入力し、その間に1つのセルを空白のままにします
  • ステップ4：別のExcelファイルに「バリデーター」と表示させる
  • ステップ5：その場所に[開発者]タブのボタン
  • ステップ6：[開発者]タブで、VisualBasicをクリックします
  • ステップ7：ビジュアルベーシックエディタが表示されます
  • ステップ8：左側にプロジェクトエクスプローラーウィンドウが表示されます。その中で太字の名前を右クリックし、[挿入]>[モジュール]を選択します。
  • ステップ9：次に、上記のコードをそのままコピーして貼り付けます
  • ステップ10：それを保存し、Excelファイルをマクロ対応ファイルとして保存します
  • ステップ11：ファイル「validator」を開き、ボタンをクリックしてコードを実行します

あなたは私が何を言おうとしているのかを理解するでしょう、あなたがコードを見れば、それは非常に理解しやすいです

誰もがこれについて私を助けることができることを願っています

4

1 に答える 1

0

ええと、それが単純に見えるので、私がそれを正しく理解するかどうかはわかりませんが、あなたは次のようなものを探していますか？

Sub Test()

dim lAppNo as long
dim sError as string 
dim lRow as long
dim lLastRow as long
dim bFlag as boolean

For lRow = 2 To lLastRow            

    rerr1 = rErr            

    lappNo = Worksheets("Sheet1").Cells(lRow, 1).value

    'Or put this in a function if you want to
    if lAppNO = 0 then 
        sError = "Blank application number found at following Row number " & lRow
        Call Write_Error(sError)
    end if

    bFlag = Check_AppNo(lAppNo, lRow, lLastRow)            

Next lRow  
End Sub

Sub Write_Error(sError As String)

Dim sPath               As String
Dim sFile               As String
Dim oBook               As Excel.Workbook
Dim oSheet              As Excel.Worksheet
Dim oRange              As Excel.Range
Dim iRange_Row          As Integer


sPath = "U:/"
sFile = "Errors.xls"
Set oBook = Workbooks.Open(sPath & sFile)
Set oSheet = oBook.Sheets("Errors")

If oSheet.Range("A1") <> "" Then
    Set oRange = oSheet.UsedRange
    iRange_Row = oRange.Rows.Count + 1
    oSheet.Cells(iRange_Row, 1).Value = Now
    oSheet.Cells(iRange_Row, 2).Value = sError
Else
    oSheet.Range("A1").Value = Now
    oSheet.Range("B1").Value = sError
End If

oBook.Save
oBook.Close

Set oRange = Nothing
Set oSheet = Nothing
Set oBook = Nothing

End Sub

セルが空白の場合、AppNoが数値データ型で定義されていると、返される値はゼロになります。
AppNoが文字列として宣言されると、空の文字列が返されます。""
すべての変数が宣言されているわけではないため、OptionExplicitを使用していないことに気付きました。
コードをより簡単に保守できるようにするために、そうすることをお勧めします。
Alsは、変数を入力するときにいくつかの規則を使用します。

于 2012-07-20T12:12:08.147 に答える