根据 VBA 中的多个条件使用用户表单更新列表

Question

我有一个包含姓名、Phone 号码、城市和晚餐的列表。

当用户填写用户表单时，他们会输入上述内容。

如果他们填写相同的名称，代码会更新列表，这样列表就不会追加另一行。我试图编辑代码，使其也考虑到 Phone 数字，但没有任何变化。

但是，如果用户添加了相同的名称但不同的编号，我该如何使列表添加新行？

Private Sub OKButton_Click()

Dim emptyRow As Long

'Make Sheet1 active
Sheet1.Activate

'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1

' try to retrieve the Name
Dim rngIdList As Range, rngId As Range
Dim phoneIdList As Range, phoneId As Range

Set rngIdList = ActiveSheet.Range([a2], [a2].End(xlDown))
Set phoneIdList = ActiveSheet.Range([b2], [b2].End(xlDown))

Set rngId = rngIdList.Find(Me.NameTextBox.Value, LookIn:=xlValues)
Set phoneId = phoneIdList.Find(Me.PhoneTextBox.Value, LookIn:=xlValues)

If rngId Is Nothing And phoneId Is Nothing Then
    ' if Name is not found, append new one to the end of the table
    With rngIdList And phoneIdList
        Set rngId = .Offset(.Rows.Count, 0).Resize(1, 1)
        Set phoneId = .Offset(.Rows.Count, 0).Resize(1, 1)
    End With
End If

' update excel record
rngId.Offset(0, 0).Value = Me.NameTextBox.Value
rngId.Offset(0, 1).Value = Me.PhoneTextBox.Value
rngId.Offset(0, 2).Value = Me.CityListBox.Value
rngId.Offset(0, 3).Value = Me.DinnerComboBox.Value

phoneId.Offset(0, 0).Value = Me.NameTextBox.Value
phoneId.Offset(0, 1).Value = Me.PhoneTextBox.Value
phoneId.Offset(0, 2).Value = Me.CityListBox.Value
phoneId.Offset(0, 3).Value = Me.DinnerComboBox.Value

预期输出：在这里您可以看到 Jake 使用不同的 phone 数字多次添加他的名字，但它没有被覆盖（如预期的那样）。但是，如果他用不同的晚餐再次添加数字 888，它将被意大利语覆盖。如果他添加数字 222，则列表中将添加另一行。

Answer 1

如此多的变量是为了让您更容易理解。类似这样的东西（未经测试，我没有构建用户表单）

Dim enteredName As String
    enteredName = Me.NameTextBox.Value

Dim headerRow As Long
    headerRow = 1 ' row containing headers

Dim lastDataRow As Long
    lastDataRow = sheet1.Cells(Rows.Count, 1).End(xlUp).Row

Dim namesRng As Range
Set namesRng = sheet1.Range("A" & headerRow + 1 & ":A" & lastDataRow)

Dim position As Variant
    ' dim as Variant because if value not found by Match
    ' instead of Long we'll receive error
    position = Application.Match(enteredName, namesRng, False)

Dim dataRow As Long ' row we'll add or update

    If IsError(position) Then
        dataRow = lastDataRow + 1 ' case: adding new row
    Else
        dataRow = position + headerRow ' case updating existing row
    End If

With sheet1.Range("A" & dataRow)
    .Value = enteredName ' not necessary when updating row, but maybe easier to read
    .Offset(0, 1).Value = Me.PhoneTextBox.Value
    .Offset(0, 2).Value = Me.CityListBox.Value
    .Offset(0, 3).Value = Me.DinnerComboBox.Value
End With

Answer 2

试试这个。它未经测试，所以让我知道你的进展情况。我添加了各种解释性评论。

Private Sub OKButton_Click()

Dim emptyRow As Long, s As String, bFound As Boolean

Sheet1.Activate
emptyRow = Range("A" & Rows.Count).End(xlUp).Row

Dim rngIdList As Range, rngId As Range

Set rngIdList = Range("A2:A" & emptyRow)
Set rngId = rngIdList.Find(Me.NameTextBox.Value, LookIn:=xlValues)

If rngId Is Nothing Then 'NAME NOT FOUND SO ADD NEW RECORD
    With Range("A" & emptyRow + 1)
        .Value = Me.NameTextBox.Value
        .Offset(0, 1).Value = Me.PhoneTextBox.Value
        .Offset(0, 2).Value = Me.CityListBox.Value
        .Offset(0, 3).Value = Me.DinnerComboBox.Value
    End With
Else 'NAME FOUND
    s = rngId.Address
    Do
        If rngId.Offset(, 1).Value = Me.PhoneTextBox.Value Then 'PHONE NUMBER FOUND FOR SAME NAME SO UPDATE RECORD
            With rngId
                .Offset(0, 2).Value = Me.CityListBox.Value
                .Offset(0, 3).Value = Me.DinnerComboBox.Value
            End With
            bFound = True
            Exit Do 'NO NEED TO KEEP LOOKING
        End If
        Set rngId = rngIdList.FindNext(rngId)
    Loop While rngId.Address <> s 'KEEP LOOKING UNTIL BACK TO FIRST FOUND VALUE
    If Not bFound Then 'IF NAME/PHONE COMBO HAS NOT BEEN FOUND
        With Range("A" & emptyRow + 1)
            .Value = Me.NameTextBox.Value
            .Offset(0, 1).Value = Me.PhoneTextBox.Value
            .Offset(0, 2).Value = Me.CityListBox.Value
            .Offset(0, 3).Value = Me.DinnerComboBox.Value
        End With
    End If
End If

End Sub

根据 VBA 中的多个条件使用用户表单更新列表

Update list with userform based on multiple criteria in VBA

excel

vba

list

userform