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 步：现在在其中输入申请编号（您想要的任何编号），中间留一个空白单元格
  • 第 4 步：让另一个 excel 文件显示“验证器”
  • 第 5 步：在那个地方的开发人员选项卡中的一个按钮
  • 第 6 步：在开发人员选项卡中，单击 Visual Basic
  • 第 7 步：您将看到一个 Visual Basic 编辑器
  • 第8步：在左侧，您将看到一个项目浏览器窗口，在该窗口中右键单击粗体名称>选择插入>模块
  • 第9步：然后按原样复制并粘贴上述代码
  • 第 10 步：保存它并将 excel 文件另存为启用宏的文件
  • 第 11 步：现在打开文件“验证器”，然后单击按钮运行代码

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

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

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 将被声明为字符串，它将返回一个空字符串：""
我注意到您没有使用 Option Explicit，因为并非所有变量都已声明。
我建议您这样做，以使您的代码更易于维护。
在键入变量时，Als 使用一些约定。

于 2012-07-20T12:12:08.147 回答