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

Question

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

我很难找到要使用的正确编码。我最初想只是将经过验证的患者信息作为消息框弹出，而不是使用文本框，但我不确定如何将匹配和索引函数输入到 VBA 编码中。而且我也不确定在这种情况下如何使用匹配/索引。我知道 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