VBA 在消息框中查找值和报告，并在同一行的单元格中更改值

Question

我正在尝试让用户表单在工作表中搜索特定 specimen_ID（AV 列）并报告列（T、S 和 W）中的项目。优选地，这些项目将在单击验证患者信息（命令按钮）后显示在消息框中。如果这些与物理测试项目匹配，则用户需要从更新列 AS 中的信息的组合框更新测试结果。

我很难找到要使用的正确编码。我最初想只是将已验证的患者信息作为消息框弹出，而不是使用文本框，但我不确定如何将匹配和索引功能输入到 VBA 编码中。而且我也不确定如何在这种情况下使用 match/index 。我知道Vlookup只有在向右搜索时才有效

包含 VBA 用户表单和编码的示例工作簿 https://www.filedropper.com/dummytest

这是该用户表单的完整代码。

Private Sub CBResult_Enter()
Me.CBResult.Clear
Me.CBResult.AddItem "Detected/Positive"
Me.CBResult.AddItem "Not detected/Negative"
Me.CBResult.AddItem "Inconclusive/Undetermined/Invalid/Equivocal"
End Sub

Private Sub CmdB_Results_Verify_Click()

Dim specimen_id As String
specimen_id = Trim(Txt_Results_SpecimenID.Text)

lastrow = Worksheets("Entry").Cells(Rows.Count, "AV").End(xlUp).Row

For i = 2 To lastrow
If Worksheets("Entry").Cells(i, 1).Value = specimen_id Then
Txt_Results_FName = Worksheets("Entry").Cells(i, "T").Value
Txt_Results_LName = Worksheets("Entry").Cells(i, "S").Value
Txt_Results_DOB = Worksheets("Entry").Cells(i, "W").Value

End If
Next

End Sub

Private Sub CmdBResult_Save_Click()

'copy values to sheet.
Dim Result As String
Result = CBResult.Value
lastrow = Worksheets("Entry").Cells(Rows.Count, "AV").End(xlUp).Row

For i = 2 To lastrow
If Worksheets("Entry").Cells(i, 1).Value = Txt_Results_specimen_id.Value Then
Worksheets("Entry").Cells("AS").Value = CBResult.Value

'Clear input Controls.

Me.CBResult.Value = ""
Txt_Results_FName.Value = ""
Txt_Results_LName.Value = ""
Txt_Results_DOB.Value = ""

End Sub

Private Sub CmdB_Results_Close_Click()
'Close "ResultsEntry"
Unload Me
End Sub

这里的文本框越少越好。

Answer 1

我已经更新了您的代码来执行我认为您想要的操作。我将粘贴整个代码，这样您就可以将整个代码放回您的用户表单代码中。

请注意：

我在标本 ID 中添加了它只接受数值。这是因为如果它是一个字符串，它将找不到匹配项，因为标本 ID 是数字。 VBA.
你没有更新你的保存按钮（当它起作用时）因为你有你的子作为：Private Sub CmdBResult_Save_Click() 当它应该是这样的：Private Sub CmdB_Results_Save_Click()
我为某些事件添加了一些消息框。如果您不想要，您显然可以编辑他们所说的内容或将其删除。
我使用 Application.Match 找到匹配而不是循环。如果您只需要更新一个匹配项，这将起作用。如果您出于某种原因需要查找重复项等，则需要更改为使用 .Find 或循环。
我将 FindResult 作为 public 变量，这样就不必两次找到标本 ID（一次获取患者详细信息，再次更新测试结果）。

让我知道它是否有问题，但它应该可以工作。我已经全部测试过了。

Public FindResult As Double

Private Sub CBResult_Enter()
Me.CBResult.Clear
Me.CBResult.AddItem "Detected/Positive"
Me.CBResult.AddItem "Not detected/Negative"
Me.CBResult.AddItem "Inconclusive/Undetermined/Invalid/Equivocal"
End Sub

Private Sub CmdB_Results_Verify_Click()

Dim specimen_id As Double

'Check something has been enetered in SpecimenID
If Len(Txt_Results_SpecimenID.Text) = 0 Then
    Exit Sub
End If
FindResult = 0
specimen_id = Txt_Results_SpecimenID.Text

On Error Resume Next
FindResult = Application.Match(specimen_id, Sheets("Entry").Range("AV:AV"), 0) 'Find the matching ID

If FindResult > 0 Then 'FindResult will be greater than 0 if match found. It will be the row that it found it on.
    Txt_Results_FName.Text = Worksheets("Entry").Range("T" & FindResult).Value
    Txt_Results_LName.Text = Worksheets("Entry").Range("S" & FindResult).Value
    Txt_Results_DOB.Text = Worksheets("Entry").Range("W" & FindResult).Value
Else
    MsgBox "No matching Specimen ID was found.", vbInformation, "No Result"
    Me.CBResult.Value = ""
    Txt_Results_FName.Value = ""
    Txt_Results_LName.Value = ""
    Txt_Results_DOB.Value = ""
End If

End Sub

Private Sub CmdB_Results_Save_Click()

'copy values to sheet.
Dim Result As String

If Len(Txt_Results_SpecimenID.Text) = 0 Then
    MsgBox "There is no Specimen ID entered. The patient info cannot be updated without this identifier.", vbExclamation, "Please enter Specimen ID"
    Exit Sub
ElseIf FindResult = 0 Then
    MsgBox "The Specimen ID has not been searched for. Please do this before trying to update the patient info.", vbExclamation, "Please enter Specimen ID"
    Exit Sub
ElseIf CBResult.Value = "" Then
    MsgBox "Please select a test result from the options.", vbExclamation, "Select a test result"
    Exit Sub
End If


Worksheets("Entry").Range("AS" & FindResult).Value = CBResult.Value

'Clear input Controls.
Me.CBResult.Value = ""
Txt_Results_FName.Value = ""
Txt_Results_LName.Value = ""
Txt_Results_DOB.Value = ""

End Sub

Private Sub CmdB_Results_Close_Click()

'Close "ResultsEntry"
Unload Me

End Sub

Private Sub Txt_Results_SpecimenID_Change()

Dim ID As String
ID = Txt_Results_SpecimenID.Text

'This will only allow numbers to be entered into the Specimen ID box
If Not IsNumeric(Right(ID, 1)) Then
    If Len(ID) = 0 Then Exit Sub
    Txt_Results_SpecimenID.Text = Left(ID, Len(ID) - 1)
End If

End Sub

VBA 在消息框中查找值和报告，并在同一行的单元格中更改值

VBA Lookup Value and report in msg box and change value in cell on same row

excel

vba

userform