使用宏在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在输入变量时使用了一些约定。