时间戳

首页 > 解决方案 > UserForm 在创建新数据 VBA 之前检查现有列表

excel - UserForm 在创建新数据 VBA 之前检查现有列表

问题描述

我想创建一个带有输入的用户表单：姓名（TextBox1），姓氏（TextBox2），出生日期（TextBox3）和1个输出，基本上是他们的ID（从1到inf）。困扰我的是，我想编写代码，如果让我们说名称和姓氏已经存在于数据库中，则会弹出 msg 并且表单将重置，否则所有内容都将被放入表中。我设法做到了。现在的问题是，如果我确实输入了已经存在的姓名和姓氏，它不会将其输入到表格中并会显示消息，但即使它不存在，消息仍会弹出但它会将其输入到表格中。这是代码：

Private Sub CommandButton1_Click()
    Dim iRow As Long
    Dim ws As Worksheet
    Set ws = Sheet2
    Dim a As Integer
 
    Application.ScreenUpdating = False
 
    iRow = ws.Range("A1048576").End(xlUp).Row + 1
    
    If Not (TextBox1.Text = "" Or TextBox2.Text = "" Or TextBox3.Text = "") Then
        With ws
            Label1.Caption = iRow - 1
                For a = 1 To iRow
                    If (ws.Cells(a, 2).Value = TextBox1.Value And ws.Cells(a, 3).Value = TextBox2.Value) Then
                        MsgBox "Values you entered already exists!"
                        Call Reset
                        Exit Sub
                    Else
                        .Range("A" & iRow).Value = Label1.Caption
                        .Range("B" & iRow).Value = TextBox1.Value
                        .Range("C" & iRow).Value = TextBox2.Value
                        .Range("D" & iRow).Value = TextBox3.Value
                    End If
                Next a
         End With
    End If

    Application.ScreenUpdating = True
End Sub

标签： excelvba

解决方案

问题是您正在检查插入新记录的行。因此，对于与新记录不匹配的每一行，都会在 iRow 中插入。当循环结束时，它会检查 iRow，匹配并显示消息。将代码分为 2 个步骤，首先检查然后更新或重置。

Private Sub CommandButton1_Click()

    If TextBox1.Text = "" Or TextBox2.Text = "" Or TextBox3.Text = "" Then
        Exit Sub
    End If

    Dim ws As Worksheet
    Dim iRow As Long, r As Long, bExists As Boolean
    Set ws = Sheet2
    iRow = ws.Cells(Rows.Count, "A").End(xlUp).Row

    ' check exists
    For r = 1 To iRow
        If (ws.Cells(r, 2).Value = TextBox1.Value) _
            And (ws.Cells(r, 3).Value = TextBox2.Value) Then
            bExists = True
            Exit For
        End If
    Next
 
    ' update sheet
    If bExists Then
        MsgBox "Values you entered already exists!"
        Call Reset
        Exit Sub
    Else
        Label1.Caption = iRow
        iRow = iRow + 1
        With ws
            .Range("A" & iRow).Value = Label1.Caption
            .Range("B" & iRow).Value = TextBox1.Value
            .Range("C" & iRow).Value = TextBox2.Value
            .Range("D" & iRow).Value = TextBox3.Value
        End With
    End If
    
End Sub

推荐阅读