Question

即时通讯在excel 2010中使用vbs，我有一个表格可以将数据添加到此电子表格中...这一切都很好，但我需要能够检查是否我没有复制数据。

电子表格中有一列，其中所有数字都应该是唯一的。

在添加值之前，我想根据列条目检查表单中的文本框值。

这就是我所需要的，我的这个迷你项目已经完成了

这是我现有的编码将数据添加到工作表

Private Sub cmdbtnSave_Click()
Dim vNewRow As Long
Dim ws As Worksheet

    Set ws = DataTable
    ' Find the next empty row
    vNewRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    ' Check for data in Field 1
    If Trim(Me.invoicemonth.Value) = "" Then
        Me.invoicemonth.SetFocus
        MsgBox "Please enter invoice month!"
        Exit Sub
    End If
    ' Check for data in Field 2
    If Trim(Me.dfrdate.Value) = "" Then
        Me.dfrdate.SetFocus
        MsgBox "Please enter DFR date!"
        Exit Sub
    End If
    ' Check for data in Field 3
    If Trim(Me.actype.Value) = "" Then
        Me.actype.SetFocus
        MsgBox "Please enter Airfraft Type!"
        Exit Sub
    End If
    ' check a/c rego
    If Trim(Me.acrego.Value) = "" Then
        Me.acrego.SetFocus
        MsgBox "Please enter Aircraft Rego!"
        Exit Sub
    End If

    ' check client
    If Trim(Me.client.Value) = "" Then
        Me.client.SetFocus
        MsgBox "Please enter Client"
        Exit Sub
    End If

    ' check destination
    If Trim(Me.dest.Value) = "" Then
        Me.dest.SetFocus
        MsgBox "Please enter in destination"
        Exit Sub
    End If

    ' check dfr hours
    If Trim(Me.dfrhrs.Value) = "" Then
        Me.dfrhrs.SetFocus
        MsgBox "Please enter DFR Hours"
        Exit Sub
    End If

    ' check if pilots name is entered
    If Trim(Me.Pilots.Value) = "" Then
        Me.Pilots.SetFocus
        MsgBox "Please input pilot name ya! wwsshhh!"
        Exit Sub
    End If

    'check if tech log hrs is entered
    If Trim(Me.txt_tloghrs.Value) = "" Then
        Me.txt_tloghrs.SetFocus
        MsgBox "wwsshh!! putim tech log hrs ya!"
        Exit Sub
    End If

    'check if tech log number is in
     If Trim(Me.txt_tlogno.Value) = "" Then
        Me.txt_tlogno.SetFocus
        MsgBox "wwsshh!! mi needim numbba blo displa tech log ya!"
        Exit Sub
     End If

    'check if engineer's name is entered
     If Trim(Me.cmb_eng.Value) = "" Then
        Me.cmb_eng.SetFocus
        MsgBox "WWSSHH! NA NEM BLO ENGINEER EM HUSAIT?"
        Exit Sub
     End If

    'check if fuel supplier is put in
     If Trim(Me.cmb_fsupply.Value) = "" Then
        Me.cmb_fsupply.SetFocus
        MsgBox "if no input select/type NULL"
        Exit Sub
     End If

    'check if branch
     If Trim(Me.cmb_branch.Value) = "" Then
        Me.cmb_branch.SetFocus
        MsgBox "if no input select/type NULL"
        Exit Sub
     End If

    'check if tech log number is in
     If Trim(Me.txt_finvoice.Value) = "" Then
        Me.txt_finvoice.SetFocus
        MsgBox "if no input select/type NULL"
        Exit Sub
     End If

    'check fuel liters
    If Trim(Me.txt_ltrs.Value) = "" Then
        Me.txt_ltrs.SetFocus
        MsgBox "if no input select/type NULL"
        Exit Sub
     End If


    ' Input the data in the Data Table
    ws.Cells(vNewRow, 1).Value = Me.invoicemonth.Value
    ws.Cells(vNewRow, 2).Value = Me.dfrdate.Value
    ws.Cells(vNewRow, 3).Value = Me.dfrnumber.Value
    ws.Cells(vNewRow, 4).Value = Me.actype.Value
    ws.Cells(vNewRow, 5).Value = Me.acrego.Value
    ws.Cells(vNewRow, 6).Value = Me.client.Value
    ws.Cells(vNewRow, 7).Value = Me.dest.Value
    ws.Cells(vNewRow, 8).Value = Me.dfrhrs.Value
    ws.Cells(vNewRow, 9).Value = Me.Pilots.Value
    ws.Cells(vNewRow, 10).Value = Me.txt_tloghrs.Value
    ws.Cells(vNewRow, 11).Value = Me.txt_tlogno.Value
    ws.Cells(vNewRow, 12).Value = Me.cmb_eng.Value
    ws.Cells(vNewRow, 13).Value = Me.cmb_fsupply.Value
    ws.Cells(vNewRow, 14).Value = Me.cmb_branch.Value
    ws.Cells(vNewRow, 15).Value = Me.txt_finvoice.Value
    ws.Cells(vNewRow, 16).Value = Me.cmb_whosupply.Value
    ws.Cells(vNewRow, 17).Value = Me.txt_ltrs.Value
    ws.Cells(vNewRow, 1).Activate

    ' Clear all fields and reset the form
    Me.invoicemonth.Value = ""
    Me.dfrdate.Value = ""
    Me.dfrnumber.Value = ""
    Me.actype.Value = ""
    Me.acrego.Value = ""
    Me.client.Value = ""
    Me.dest.Value = ""
    Me.dfrhrs.Value = ""
    Me.Pilots.Value = ""
    Me.txt_tloghrs.Value = ""
    Me.txt_tlogno.Value = ""
    Me.cmb_eng.Value = ""
    Me.cmb_fsupply.Value = ""
    Me.cmb_branch.Value = ""
    Me.txt_finvoice.Value = ""
    Me.cmb_whosupply.Value = ""
    Me.txt_ltrs.Value = ""
    Me.invoicemonth.SetFocus`

Answer 1

使用子程序，您可以比在一个大块中更容易地执行此操作。您需要在UserForm激活时为某些变量设置值，例如“ws”。

您的保存按钮单击事件将只是几行，然后执行每个子例程。首先检查重复项，然后检查清空，然后复制数据，保存工作簿和清除表单以获取另一个条目。您仍然必须使用您正在执行的操作来导航记录或考虑将数据放在哪一行。我相信你使用“VNewRow”的例子。

Private Sub cmdbtnSave_Click()

    If IsDuplicate() = False Then   
        Call CheckEmpty
        Call SaveData
        ActiveWorkbook.Save
        Call ClearData
    Else
        MsgBox("Duplicate records exist for " & txtBoxToCheck.Value & "!")
        'Anything else you want to accomplish, such as reset the form
        'You can Call ClearData here.  
    End If

End Sub

然后你需要一个子程序来检查列上需要全部唯一的Duplicates。在此示例中，“txtBoxToCheck”是文本框的名称，它位于Sheet1列“A”上。当它运行时，如果没有重复，它将返回False，如果有，则返回True。然后保存事件将基于此保存或不保存。

Function IsDuplicate() As Boolean
Dim lastRow As Long
Dim resultCheck As Boolean
lastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row   'gets last row of Sheet1

For row = 2 to lastRow     'Assuming you have a Header Row and Data begins on row 2.
    If txtBoxToCheck.Value = Sheets("Sheet1").Cells(row , 1).Value Then
        resultCheck = True
        End For
    Else
        resultCheck = False
    End If
Next row      'loop until last row of sheet1
IsDuplicate = resultCheck
End Sub

这会丢失您的自定义消息框，但会节省您的时间。在此示例中，如果在每个控件上设置不能为空的Tag属性。在示例中，它们标记为“NoEmpty”。您可以删除If / Then语句列表，每个语句具有相同的代码，只有一个值发生更改并改为调用它。

Private Sub CheckEmpty()

    Dim ctl As MSForms.Control

    For Each ctl In YourForm.Controls   'Set to your form name
        If ctl.Tag = "NoEmpty" Then
            If (ctl.Value = "")) Then
                MsgBox ("Set value for " & ctl.Name)
                ctl.SetFocus      
            End If
        End If
    Next ctl

End Sub

这样可以减轻每个单元格检查空白的if语句。

你会有一个单独的SaveData子程序。取自原始代码，不带“我”。

Private Sub SaveData()
    'Input the data in the Data Table
    ws.Cells(vNewRow, 1).Value = invoicemonth.Value
    ws.Cells(vNewRow, 2).Value = dfrdate.Value
    ws.Cells(vNewRow, 3).Value = dfrnumber.Value
    ws.Cells(vNewRow, 4).Value = actype.Value
    ws.Cells(vNewRow, 5).Value = acrego.Value
    ws.Cells(vNewRow, 6).Value = client.Value
    ws.Cells(vNewRow, 7).Value = dest.Value
    ws.Cells(vNewRow, 8).Value = dfrhrs.Value
    ws.Cells(vNewRow, 9).Value = Pilots.Value
    ws.Cells(vNewRow, 10).Value = txt_tloghrs.Value
    ws.Cells(vNewRow, 11).Value = txt_tlogno.Value
    ws.Cells(vNewRow, 12).Value = cmb_eng.Value
    ws.Cells(vNewRow, 13).Value = cmb_fsupply.Value
    ws.Cells(vNewRow, 14).Value = cmb_branch.Value
    ws.Cells(vNewRow, 15).Value = txt_finvoice.Value
    ws.Cells(vNewRow, 16).Value = cmb_whosupply.Value
    ws.Cells(vNewRow, 17).Value = txt_ltrs.Value

End Sub

另一个用于ClearData，再次使用上面的代码而没有“我。”

Private Sub ClearData()
    'Clear all fields and reset the form
    invoicemonth.Value = ""
    dfrdate.Value = ""
    dfrnumber.Value = ""
    actype.Value = ""
    acrego.Value = ""
    client.Value = ""
    dest.Value = ""
    dfrhrs.Value = ""
    Pilots.Value = ""
    txt_tloghrs.Value = ""
    txt_tlogno.Value = ""
    cmb_eng.Value = ""
    cmb_fsupply.Value = ""
    cmb_branch.Value = ""
    txt_finvoice.Value = ""
    cmb_whosupply.Value = ""
    txt_ltrs.Value = ""
    invoicemonth.SetFocus

 End Sub

总而言之，通过这种方式，您可以更轻松地调整代码以适应类似的未来项目，同时使您或其他可能需要处理代码的人员更容易进行调试。保持导航和其他验证方法，只需修改数据的来源和位置，以及UserForm控件，工作表等的具体名称。

编辑：为代码添加了澄清和更多注释。

在添加到电子表格之前，要检查列中重复项的文本框值

1 个答案: