VBA 조회 값 및 메시지 상자의 보고서 및 동일한 행의 셀에서 값 변경

내가 원하는 것을 수행하도록 코드를 업데이트했습니다. 전체 코드를 붙여 넣어 전체 코드를 사용자 양식 코드에 다시 넣을 수 있습니다.

참고 :

• 숫자 값만 허용하도록 표본 ID에 추가했습니다. 이는 문자열이면 표본 ID가 숫자이므로 일치하는 항목을 찾지 못하기 때문입니다. VBA에서는 숫자와 문자열이 다르게 처리됩니다.
• 당신은 당신의 잠수함을 다음과 같이 가지고 있었기 때문에 저장 버튼을 업데이트하지 않았습니다 (작동 할 때) Private Sub CmdBResult_Save_Click().Private Sub CmdB_Results_Save_Click()
• 특정 이벤트에 대한 메시지 상자를 추가했습니다. 그들이 말하는 것을 분명히 편집하거나 원하지 않으면 제거 할 수 있습니다.
• 나는 Application.Match반복하는 대신 일치 하는 것을 찾았습니다. 업데이트해야하는 일치 항목이 하나만있는 경우에만 작동합니다. 어떤 이유로 중복을 찾아야하는 경우 .Find또는 루프 를 사용하도록 변경해야합니다 .
• FindResult표본 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