VBA UserForm 여러 레코드 찾기, 표시 및 순환

Question

시트에서 고유 ID를 검색하고 같은 행에있는 관련 데이터를 표시하는 userform을 만듭니다.

나는 다른 StackOverflow의 질문의 도움을 사용했지만 나를 위해 정확하게 작동하지 않습니다

내가 찾고 있어요 고유 한 ID로 여러 데이터 세트가 있습니다

. 아래 코드는 find를 클릭하면 발견 된 첫 번째 레코드를 보여주고 얼마나 많은 레코드가 시트에 있는지 사용자에게 알려주는 메시지 상자가 나타납니다. 확인을 클릭하면 사용자 정의 폼이 닫힙니다.

편집하려면 확인을 클릭 한 후 사용자가 FindNext 버튼을 클릭하면 userform에 원래 검색과 일치하는 다른 모든 레코드가 표시됩니다. (updateFields에서 anchorCell.Select 참조) FindNext_Click의 코드는 마지막 행이 현재 선택으로 설정 한 보였다는 사실을 사용

Private Sub FindNext_Click() 
    Dim nextCell As Range 
    Set nextCell = Cells.FindNext(After:=ActiveCell) 
    'FindNext loops round to the initial cell if it finds no other so we test for it 
    If Not nextCell.Address(external:=True) = ActiveCell.Address(external:=True) Then 
     updateFields anchorCell:=nextCell 
    End If 
End Sub 

Private Sub Find_Click() 
    Worksheets("Master").Activate 
    Dim strFind As String 
    Dim FirstAddress As String 
    Dim rSearch As Range 
    Set rSearch = Range("a1", Range("a65536").End(xlUp)) 
    Dim f  As Integer 
    Dim c As Object 

    strFind = Me.TextBox1.Value 

    With rSearch 
     Set c = .Find(strFind, LookIn:=xlValues) 
     If Not c Is Nothing Then 
      updateFields anchorCell:=c 
      FirstAddress = c.Address 
      Do 
       f = f + 1 
       Set c = .FindNext(c) 
      Loop While Not c Is Nothing And c.Address <> FirstAddress 
      If f > 1 Then 
       Select Case MsgBox("There are " & f & " instances of " & strFind, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries") 

        Case vbOK 
        Case vbCancel 

       End Select 
       Me.Height = frmMax 

      End If 
     Else: MsgBox strFind & " not listed" 
     End If 
    End With 

End Sub 


Private Sub updateFields(anchorCell As Range) 
anchorCell.Select 
With Me 
    .TextBox2.Value = anchorCell.Offset(0, 2).Value 
    .TextBox3.Value = anchorCell.Offset(0, 3).Value 
    .TextBox4.Value = anchorCell.Offset(0, 4).Value 
    .TextBox6.Value = anchorCell.Offset(0, 13).Value 
    .TextBox7.Value = anchorCell.Offset(0, 14).Value 
    .TextBox8.Value = anchorCell.Offset(0, 15).Value 
    .TextBox9.Value = anchorCell.Offset(0, 16).Value 
    .TextBox10.Value = anchorCell.Offset(0, 17).Value 
    .TextBox11.Value = anchorCell.Offset(0, 18).Value 
    .TextBox12.Value = anchorCell.Offset(0, 19).Value 
    .TextBox13.Value = anchorCell.Offset(0, 20).Value 
    .TextBox14.Value = anchorCell.Offset(0, 21).Value 
    .TextBox20.Value = anchorCell.Offset(0, 22).Value 
End With 
End Sub 

감사

Answer 1

: 아래

는 코드입니다. 문제는이 호출 사이에 사용자가 다른 셀이나 다른 워크 시트를 선택했기 때문에 런타임 오류가 발생한다는 것입니다.

나는이 다소 어려울 것이다 좀 더 정보가 없으면 "

Option Explicit 
Private anchor As Range ' keeps track of the last shown row 

Private Sub Find_Click() 
    ' Only Displays the number of matches and delegates the updating to FidNext 
    Dim count As Long 
    count = WorksheetFunction.CountIf(Worksheets("Master").UsedRange.Columns("A"), TextBox1.Value) 
    If count < 1 Then 
     msgBox TextBox1.Value & " not listed" 
     FindNext.Enabled = False 
     Exit Sub 
    End If 
    FindNext.Enabled = True 
    Set anchor = Worksheets("Master").Range("A65536").End(xlUp) 
    FindNext_Click ' Now delegate the work to FindNext 
End Sub 

Private Sub FindNext_Click() 
'responsible of updating the userform and scrolling to the next field 
    Set anchor = Worksheets("Master").UsedRange.Columns("A").Find(TextBox1.Value, anchor) 

    TextBox2.Value = anchor.offset(0, 2).Value 
    TextBox3.Value = anchor.offset(0, 3).Value 
    TextBox4.Value = anchor.offset(0, 4).Value 
    TextBox6.Value = anchor.offset(0, 13).Value 
    TextBox7.Value = anchor.offset(0, 14).Value 
    TextBox8.Value = anchor.offset(0, 15).Value 
    TextBox9.Value = anchor.offset(0, 16).Value 
    TextBox10.Value = anchor.offset(0, 17).Value 
    TextBox11.Value = anchor.offset(0, 18).Value 
    TextBox12.Value = anchor.offset(0, 19).Value 
    TextBox13.Value = anchor.offset(0, 20).Value 
    TextBox14.Value = anchor.offset(0, 21).Value 
    TextBox20.Value = anchor.offset(0, 22).Value 

    Worksheets("Master").Activate 
    anchor.EntireRow.Activate 
End Sub