使用宏在Excel中驗證空白字段

Question

我在驗證空白字段時遇到了一點困難。

當我使用此代碼打開一個文件，它會打開文件，該列中的應用程序數量檢查（在這裏我的申請號是在第一列）

我所試圖做的是，如果存在，那麼它應該寫出下面的錯誤沒有申請號「空白申請號發現在以下行號」

'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：先用名稱的Excel文件說「ABC1」
• 第2步：在該文件中，在第1列，給予其爲「申請號」
• 步驟3項：現在，在它輸入申請編號（任何數量的你想），並在兩者之間留一個池空白
• 步驟4：另一個Excel文件說「驗證」
• 第5步：在那個地方從開發人員選項卡按鈕
• 步驟6：開發人員選項卡，點擊Visual Basic
• 第7步：您將看到一個可視化的基本編輯器
• 第8步：在左邊，你會看到一個項目的資源管理器窗口中，大膽的名稱>選擇插入即右鍵>模塊
• 第9步：然後複製並粘貼上述代碼，因爲它是
• 第10步：保存並還保存Excel文件作爲宏啓用文件
• 第11步：現在打開文件「驗證」，並在點擊按鈕來運行代碼

，你會得到的想法就是我我想說，如果你看到代碼，這很容易理解

希望，任何人都可以幫助我在此

Answer 1

嗯，我不能肯定，如果我得到它的權利，因爲它看起來很簡單，但你要找的東西，如：

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聲明爲字符串，它將返回一個空字符串：「」
我注意到您不使用Option Explicit，因爲並非所有變量都被聲明。
我建議你這樣做，以保持你的代碼更易於維護。
Als在輸入變量時使用了一些約定。