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：首先制作一个名为“abc1”
步骤2：在该文件的第1栏中，将其标题命名为“申请号”
步骤3：现在在其中键入应用程序编号（您想要的任何数字），并在其间留下一个单元格空白
第4步：制作另一个excel文件说“验证者”
步骤5：在该位置显示开发人员标签中的按钮
第6步：在开发人员标签中，点击visual basic
第7步：您将看到一个visual basic editor
步骤8：在左侧，您将看到一个项目资源管理器窗口，右键单击粗体名称＆gt;选择插入＆gt;模块
步骤9：然后复制并粘贴上述代码
步骤10：保存并将excel文件另存为启用宏的文件
步骤11：现在打开文件“validator”，然后点击按钮运行代码

你会明白我想说的是什么，如果你看到代码，那就很容易理解了

希望，任何人都可以帮助我

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将被声明为String，它将返回一个空字符串：“”
我注意到你没有使用Option Explicit，因为并非所有的变量都被声明了我建议你这样做，以保持代码更容易维护。
输入变量时，Als会使用一些约定。

使用宏验证Excel中的空白字段

1 个答案: