목록 상자에서 하나의 항목 만 업데이트됩니까?

Question

안녕 다음 코드를 검색하고 검색 한 항목이 목록 상자에 표시됩니다. 또한 텍스트 상자에 입력 한 새로운 정보를 업데이트하는 업데이트 단추가 있습니다. 업데이트 상자가 제대로 작동하지만 여러 중복 항목이 목록 상자에 표시되고 두 번째 인스턴스를 클릭하여 업데이트하려고하면 어떤 이유로 원본 및 두 번째 인스턴스가 업데이트됩니다. 따라서 첫 번째 인스턴스는 첫 번째 인스턴스 항목을 업데이트하고 두 번째는 두 번째를 업데이트해야하지만 첫 번째 인스턴스는 첫 번째 인스턴스를 업데이트하고 두 번째 인스턴스는 첫 번째 인스턴스를 업데이트하며 세 번째 인스턴스는 첫 번째 인스턴스를 업데이트합니다. 내가 어떻게 고칠 수 있니? https://www.dropbox.com/s/36e9fmbf17wpa0l/example.xlsm

Public Sub Search_Click() 
Dim Name As String 
Dim f As Range 
Dim s As Integer 
Dim FirstAddress As String 
Dim str() As String 
Dim ws As Worksheet 

Set ws = ThisWorkbook.Worksheets("Master") 

Name = surname.Value 

With ws 
Set f = .Range("A:A").Find(what:=Name, LookIn:=xlValues) 
    If Not f Is Nothing Then 
    With Me 
    firstname.Value = f.Offset(0, 1).Value 
    tod.Value = f.Offset(0, 2).Value 
    program.Value = f.Offset(0, 3).Value 
    email.Value = f.Offset(0, 4).Text 

    SetCheckBoxes f.Offset(0, 5) '<<< replaces code below 

    officenumber.Value = f.Offset(0, 6).Text 
    cellnumber.Value = f.Offset(0, 7).Text 
    r = f.Row 
    End With 
    findnext 
     FirstAddress = f.Address 
Do 
    s = s + 1 
    Set f = Range("A:A").findnext(f) 
      Loop While Not f Is Nothing And f.Address <> FirstAddress 
    If s > 1 Then 
     Select Case MsgBox("There are " & s & " instances of " & Name, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries") 

     Case vbOK 
      findnext 
     Case vbCancel 

     End Select 

    End If 

Else: MsgBox Name & "Not Listed" 

End If 

End With 

End Sub 

'----------------------------------------------------------------------------- 
Sub findnext() 
Dim Name As String 
Dim f As Range 
Dim ws As Worksheet 
Dim s As Integer 
Dim findnext As Range 

Name = surname.Value 
Me.ListBox1.Clear 
Set ws = ThisWorkbook.Worksheets("Master") 
With ws 
Set f = .Cells(r, 1) 
Set findnext = f 

With ListBox1 
    Do 
Debug.Print findnext.Address 
Set findnext = Range("A:A").findnext(findnext) 

.AddItem findnext.Value 
.List(.ListCount - 1, 1) = findnext.Offset(0, 1).Value 
.List(.ListCount - 1, 2) = findnext.Offset(0, 2).Value 
.List(.ListCount - 1, 3) = findnext.Offset(0, 3).Value 
.List(.ListCount - 1, 4) = findnext.Offset(0, 4).Value 
.List(.ListCount - 1, 5) = findnext.Offset(0, 5).Value 
.List(.ListCount - 1, 6) = findnext.Offset(0, 6).Value 
.List(.ListCount - 1, 7) = findnext.Offset(0, 7).Value 
.List(.ListCount - 1, 8) = findnext.Offset(0, 8).Value 
Loop While findnext.Address <> f.Address 
End With 
End With 

End Sub 

'---------------------------------------------------------------------------- 
Public Sub update_Click() 
MsgBox "Directorate has been updated!" 
Dim Name As String 
Dim f As Range 
Dim ws As Worksheet 

Set ws = ThisWorkbook.Worksheets("Master") 
With ws 
Set f = .Cells(r, 1) 

    f.Value = surname.Value 
    f.Offset(0, 1).Value = firstname.Value 
    f.Offset(0, 2).Value = tod.Value 
    f.Offset(0, 3).Value = program.Value 
    f.Offset(0, 4).Value = email.Value 
    f.Offset(0, 5).Value = GetCheckBoxes 
    f.Offset(0, 6).Value = officenumber.Value 
    f.Offset(0, 7).Value = cellnumber.Value 

End With 
End Sub 

Answer 1

첫 번째 명백한 문제가 r이다 :이 문서입니다. 이 전역 변수는 Search_Click에 의해 임시 변수로 사용되며 마스터 변수로 update_Click에 의해 사용됩니다.

update_Click을 고려하십시오. 시작 부분에 우리가 있습니다

Set ws = ThisWorkbook.Worksheets("Master") 
With ws 
    Set f = .Cells(r, 1) 

당신이 양식을로드 필드를 작성하고 업데이트 다음 r이 너무 초기화 제로의 기본값이되지 않았을 것입니다을 클릭합니다.

이 양식이 무엇을 달성하려고 하는지를 추측하는 것은 매우 어렵습니다. 대부분의 버튼은 아무 것도하지 않습니다. 작동하는 두 버튼 중 어느 것도 문서화되어 있지 않습니다. 이 양식이 개발 중이다. 감사하게 생각하지만, 사람들에게 디버깅을 도와달라고 부탁한다면 쉽게 그렇게해야한다.

update_Click의 목표는 워크 시트 "마스터"의 맨 아래에 새 행을 추가하는 것입니다. 이 가정이 사실이라면 나는 다음과 같은 제안 : 당신은 내가 바른 길에 있음을 확인하는 경우

Public Sub update_Click() 

    MsgBox "Directorate has been updated!" 

    Dim RowNext As Long 

    With ThisWorkbook.Worksheets("Master") 

    ' There is no checking of the values entered by the user. 
    ' I have assumed that the surname is present on the last used row. 
    ' If this assumption is untrue, the new data will overwrite the row 
    ' below the last row with a surname. 
    RowNext = .Cells(Rows.Count, "A").End(xlUp).Row + 1 

    .Cells(RowNext, "A").Value = surname.Value 
    .Cells(RowNext, "B").Value = firstname.Value 
    .Cells(RowNext, "C").Value = tod.Value 
    .Cells(RowNext, "D").Value = program.Value 
    .Cells(RowNext, "E").Value = email.Value 
    .Cells(RowNext, "F").Value = GetCheckBoxes 
    .Cells(RowNext, "G").Value = officenumber.Value 
    .Cells(RowNext, "H").Value = cellnumber.Value 

    End With 

End Sub 

것은, 내가 Search_Click를 보라.

Answer 2

아래 코드는 귀하의 코드와 크게 다릅니다. 부분적으로 이것은 코드가 작동하지 않았기 때문에, 내가 테스트 한 범위 내에서 그렇습니다. 하지만 대부분의 변경 사항은 내가 귀하의 코드를 이해하지 못해서 발생합니다. 내가 코드를 작성하면서 문서화하고 의미있는 이름으로 바꾸고 달성하고자하는 효과를 구현했습니다.

코드를 만들 때 6 개월에서 12 개월 후에 새로운 요구 사항에 맞게 코드가 업데이트됩니다. 코드를 작성하면서 코드를 이해하기 쉽게 만드는 데 약간의 시간을 투자하면 유지 관리가 필요할 때 시간을 절약 할 수 있습니다. 변수를 체계적으로 이름을 지정하여 돌아올 때 자신이 무엇인지 즉시 알 수 있습니다. 업데이트하고자하는 코드를 찾을 수 있도록 각 서브 루틴과 코드 블록이 달성하고자하는 것을 설명하십시오.

먼저 양식을 변경했습니다. 양식을 조금 더 깊게 만들고 목록 상자를 아래로 이동했습니다. 목록 상자 위에 나는 이름이 lblMessage 인 레이블을 삽입했습니다. 이 레이블은 양식의 전체 너비에 걸쳐 있으며 3 줄 깊이 있습니다. 텍스트의 대부분은 Tahoma 8입니다.이 레이블은 Tahoma 10이며 파란색으로 표시됩니다. 나는 그들이 사용자에게 무엇을 할 것으로 예상되는지 알려주기 위해 사용한다.

는 폼의 코드의 첫 번째 라인으로 내가 추가 한 : 그것은 항상 존재해야하는 이유를 볼까지

Option Explicit 

이 문을 봐.

워크 시트의 여러 열에 액세스하려면 간격 띄우기를 사용합니다. 기둥이 재 배열 될 때마다 악몽이 될 수 있습니다. 나는 상수를 사용했다 :

는

Const ColMasterFamilyName As String = "A" 
Const ColMasterGivenName As String = "B" 
Const ColMasterTitle As String = "C" 
Const ColMasterProgArea As String = "D" 
Const ColMasterEMail As String = "E" 
Const ColMasterStakeHolder As String = "F" 
Const ColMasterOfficePhone As String = "G" 
Const ColMasterCellPhone As String = "H" 

이 더 이상 당신보다 내 문을 만드는 대신 5의, 말하자면, 나는 이름이 있다는 것을 의미한다.

이 상수는 내 시스템을 사용하여 이름이 지정됩니다. "Col"는이 열이라고 말합니다. "마스터"는 그들이 적용하는 워크 시트를 말합니다. "FamilyName"은 어떤 열을 말합니다. 귀하의 코드에서 "성"과 "성"을 사용하십시오. 나는 "성"과 "이름"이 "문화적으로 민감"하지 않은 지역에서 너무 오랫동안 일했습니다. 내 시스템이 마음에 들지 않겠지 만 시스템이 있어야합니다. 저는 몇 년 전에 쓴 코드를보고 변수가 무엇인지 알 수 있습니다.

내가 대체했다 당신 :와

Public r As Long 

:

Dim RowEnteredName() As Long 

내가 모든 선택이 배열을 redimension. 입력 된 이름과 일치하는 행이 하나 뿐인 경우 ReDim RowEnteredName(1 To 1)으로, 행 번호가 RowEnteredName(1) 인 행이 있습니다. Count 행이 입력 된 이름과 일치하면 ReDim RowEnteredName(0 To Count)으로 디멘션됩니다. RowEnteredName(0)은 머리말 행에 해당하기 때문에 사용되지 않으며 RowEnteredName(1 To Count)은 각 반복의 행 번호를 보유합니다.

양식을 사용할 준비를하기 위해 양식 초기화 루틴을 추가했습니다.

키워드를 서브 루틴이나 변수의 이름으로 사용할 수 없기 때문에 findnext을 FillListBox으로 다시 코딩했습니다.

당신의 코드에 내가 주석 처리 한 루틴이있어서 아래 코드가 완전하다는 것을 알고 있습니다.

나는 이것이 모두 의미가 있기를 바랍니다.

Option Explicit 

Const ColMasterFamilyName As String = "A" 
Const ColMasterGivenName As String = "B" 
Const ColMasterTitle As String = "C" 
Const ColMasterProgArea As String = "D" 
Const ColMasterEMail As String = "E" 
Const ColMasterStakeHolder As String = "F" 
Const ColMasterOfficePhone As String = "G" 
Const ColMasterCellPhone As String = "H" 

Dim RowEnteredName() As Long 
Private Sub ListBox1_Click() 
'pop listbox when more than one instances are prompted 
'cliking the person's name will change the textboxes 
'transfer the values to updateclick 

    Dim RowMasterCrnt As Long 

    If ListBox1.ListIndex = 0 Then 
    'Debug.Assert False 
    lblMessage.Caption = "You cannot select the heading row. Please select a person." 
    Exit Sub 
    End If 

    With ThisWorkbook.Worksheets("Master") 

    RowMasterCrnt = RowEnteredName(ListBox1.ListIndex) 

    ReDim RowEnteredName(1 To 1) 
    RowEnteredName(1) = RowMasterCrnt 

    surname.Value = .Cells(RowMasterCrnt, ColMasterFamilyName).Value 
    firstname.Value = .Cells(RowMasterCrnt, ColMasterGivenName).Value 
    tod.Value = .Cells(RowMasterCrnt, ColMasterTitle).Value 
    program.Value = .Cells(RowMasterCrnt, ColMasterProgArea).Value 
    email.Value = .Cells(RowMasterCrnt, ColMasterEMail).Value 
    Call SetCheckBoxes(.Cells(RowMasterCrnt, ColMasterStakeHolder).Value) 
    officenumber.Value = .Cells(RowMasterCrnt, ColMasterOfficePhone).Value 
    cellnumber.Value = .Cells(RowMasterCrnt, ColMasterCellPhone).Value 
    lblMessage.Caption = "Please change details as required then click [Update]. " & _ 
         "If you have selected the wrong person, " & _ 
         "please click [Select] to reselect." 
    update.Visible = True 

    End With 

    ListBox1.Visible = False ' Cannot use again because RowEnteredName changed 

End Sub 
Private Sub Search_Click() 

    ' User should have entered a Family name before clicking Search. 
    If surname.Value = "" Then 
    Debug.Assert False ' Not tested 
    lblMessage.Caption = "Please enter a Family name or Surname" 
    Exit Sub 
    End If 

    Dim Name As String 
    Dim CellNameFirst As Range  ' First cell, if any, holding family name 
    Dim Count As Long 
    Dim FirstAddress As String 

    lblMessage.Caption = "" 
    Name = surname.Value 

    With ThisWorkbook.Worksheets("Master") 

    ' Look for entered family name in appropriate column 
    Set CellNameFirst = .Columns(ColMasterFamilyName).Find(_ 
          what:=Name, after:=.Range(ColMasterFamilyName & "1"), _ 
          lookat:=xlWhole, LookIn:=xlValues, _ 
          SearchDirection:=xlNext, MatchCase:=False) 
    If Not CellNameFirst Is Nothing Then 

     ' There is at least one person with the entered family name. 

     ' Fill the listbox and make it visible if there is more than one person 
     ' with the entered family name 
     'Debug.Assert False ' Not tested 
     Call FillListBox(CellNameFirst) 

     If ListBox1.Visible Then 
     ' There is more than one person with the entered name 
     ' Ensure update not available until selection made from list box 
     'Debug.Assert False ' Not tested 
     update.Visible = False 
     lblMessage.Caption = "Please click the required person within the listbox" 
     Exit Sub 
     Else 
     ' Only one person with entered name 
     ' Prepare the entry controls for updating by the user 

     'Debug.Assert False ' Not tested 
     ReDim RowEnteredName(1 To 1) 
     RowEnteredName(1) = CellNameFirst.Row ' Record row for selected family name 

     firstname.Value = .Cells(RowEnteredName(1), ColMasterGivenName).Value 
     tod.Value = .Cells(RowEnteredName(1), ColMasterTitle).Value 
     program.Value = .Cells(RowEnteredName(1), ColMasterProgArea).Value 
     email.Value = .Cells(RowEnteredName(1), ColMasterEMail).Value 
     Call SetCheckBoxes(.Cells(RowEnteredName(1), ColMasterStakeHolder).Value) 
     officenumber.Value = .Cells(RowEnteredName(1), ColMasterOfficePhone).Value 
     cellnumber.Value = .Cells(RowEnteredName(1), ColMasterCellPhone).Value 
     lblMessage.Caption = "Please change details as required then click Update" 
     update.Visible = True 
     End If 
    Else 
     Debug.Assert False ' Not tested 
     lblMessage.Caption = "No person found with that name. Please try another." 
     update.Visible = False 
    End If 

    End With 

End Sub 
Public Sub update_Click() 

    With ThisWorkbook.Worksheets("Master") 

    .Cells(RowEnteredName(1), "A").Value = surname.Value 
    .Cells(RowEnteredName(1), "B").Value = firstname.Value 
    .Cells(RowEnteredName(1), "C").Value = tod.Value 
    .Cells(RowEnteredName(1), "D").Value = program.Value 
    .Cells(RowEnteredName(1), "E").Value = email.Value 
    .Cells(RowEnteredName(1), "F").Value = GetCheckBoxes 
    .Cells(RowEnteredName(1), "G").Value = officenumber.Value 
    .Cells(RowEnteredName(1), "H").Value = cellnumber.Value 

    End With 

    ' Clear controls ready for next select and update 
    surname.Value = "" 
    firstname.Value = "" 
    tod.Value = "" 
    program.Value = "" 
    email.Value = "" 
    Call SetCheckBoxes("") 
    officenumber.Value = "" 
    cellnumber.Value = "" 

    lblMessage.Caption = "Please enter the family name or surname of the " & _ 
         "person whose details are to be updated then " & _ 
         "click [Search]." 

    update.Visible = False 

End Sub 
Private Sub UserForm_Initialize() 

    ' Set controls visible or invisible on initial entry to form. 

    ' Update is not available until Search has been clicked and current 
    ' details of a single person has been displayed. 
    update.Visible = False 

    ' The listbox is only used if Search finds the entered name matches 
    ' two or more people 
    ListBox1.Visible = False 

    ' Search is the first button to be clicked and is always available 
    ' as a means of cancelling the previous selection. 
    Search.Visible = True 

    ' Not yet implemented 
    CommandButton1.Visible = False 
    CommandButton2.Visible = False 
    CommandButton3.Visible = False 
    CommandButton7.Visible = False 

    lblMessage.Caption = "Please enter the family name or surname of the " & _ 
         "person whose details are to be updated then " & _ 
         "click [Search]." 

End Sub 
Function ColCodeToNum(ColStg As String) As Integer 

    ' Convert 1 or 2 character column identifiers to number. 
    ' A -> 1; Z -> 26: AA -> 27; and so on 

    Dim lcColStg     As String 

    lcColStg = LCase(ColStg) 
    ColCodeToNum = IIf(Len(ColStg) > 1, (Asc(Left(ColStg, 1)) - 64) * 26, 0) + _ 
       Asc(Right(ColStg, 1)) - 64 

End Function 
Sub FillListBox(CellNameFirst As Range) 

    ' CellNamefirst is the first, possibly only, cell for the 
    ' family name entered by the user. 
    ' Clear the listbox. If there is more than one person with the 
    ' entered family name, make the listbox visible and fill it with 
    ' every person with the same family name 

    Dim CellName As Range 
    Dim Count As Long 
    Dim ListBoxData() As String 
    Dim RowMasterCrnt As Long 
    Dim LbEntryCrnt As Long 

    Me.ListBox1.Clear 
    Set CellName = CellNameFirst 

    ' Count number of rows with same family name as CellNameFirst 
    Count = 1 
    With ThisWorkbook.Worksheets("Master") 
    Do While True 
     Set CellName = .Columns(ColMasterFamilyName).findnext(CellName) 
     If CellName.Row = CellNameFirst.Row Then 
     'Debug.Assert False 
     Exit Do 
     End If 
     'Debug.Assert False 
     Count = Count + 1 
    Loop 
    End With 

    If Count = 1 Then 
    ' Only one person has the entered family name 
    'Debug.Assert False 
    Me.ListBox1.Visible = False 
    Exit Sub 
    End If 

    'Debug.Assert False 
    Set CellName = CellNameFirst 

    ReDim ListBoxData(1 To 8, 0 To Count)  ' Row 0 used for column headings 
    ReDim RowEnteredName(0 To Count) 
    LbEntryCrnt = 0 

    With ThisWorkbook.Worksheets("Master") 

     ' Create column headings 
     ListBoxData(ColCodeToNum(ColMasterFamilyName), LbEntryCrnt) = _ 
             .Cells(2, ColMasterFamilyName).Value 
     ListBoxData(ColCodeToNum(ColMasterGivenName), LbEntryCrnt) = _ 
              .Cells(2, ColMasterGivenName).Value 
     ListBoxData(ColCodeToNum(ColMasterTitle), LbEntryCrnt) = _ 
               .Cells(2, ColMasterTitle).Value 
     ListBoxData(ColCodeToNum(ColMasterProgArea), LbEntryCrnt) = _ 
              .Cells(2, ColMasterProgArea).Value 
     ListBoxData(ColCodeToNum(ColMasterEMail), LbEntryCrnt) = _ 
               .Cells(2, ColMasterEMail).Value 
     ListBoxData(ColCodeToNum(ColMasterStakeHolder), LbEntryCrnt) = _ 
             .Cells(2, ColMasterStakeHolder).Value 
     ListBoxData(ColCodeToNum(ColMasterOfficePhone), LbEntryCrnt) = _ 
             .Cells(2, ColMasterOfficePhone).Value 
     ListBoxData(ColCodeToNum(ColMasterCellPhone), LbEntryCrnt) = _ 
              .Cells(2, ColMasterCellPhone).Value 
     LbEntryCrnt = LbEntryCrnt + 1 

    Do While True 

     ' For each row with the same family name, add details to array 
     RowMasterCrnt = CellName.Row 
     ListBoxData(ColCodeToNum(ColMasterFamilyName), LbEntryCrnt) = _ 
          .Cells(RowMasterCrnt, ColMasterFamilyName).Value 
     ListBoxData(ColCodeToNum(ColMasterGivenName), LbEntryCrnt) = _ 
           .Cells(RowMasterCrnt, ColMasterGivenName).Value 
     ListBoxData(ColCodeToNum(ColMasterTitle), LbEntryCrnt) = _ 
            .Cells(RowMasterCrnt, ColMasterTitle).Value 
     ListBoxData(ColCodeToNum(ColMasterProgArea), LbEntryCrnt) = _ 
           .Cells(RowMasterCrnt, ColMasterProgArea).Value 
     ListBoxData(ColCodeToNum(ColMasterEMail), LbEntryCrnt) = _ 
            .Cells(RowMasterCrnt, ColMasterEMail).Value 
     ListBoxData(ColCodeToNum(ColMasterStakeHolder), LbEntryCrnt) = _ 
          .Cells(RowMasterCrnt, ColMasterStakeHolder).Value 
     ListBoxData(ColCodeToNum(ColMasterOfficePhone), LbEntryCrnt) = _ 
          .Cells(RowMasterCrnt, ColMasterOfficePhone).Value 
     ListBoxData(ColCodeToNum(ColMasterCellPhone), LbEntryCrnt) = _ 
           .Cells(RowMasterCrnt, ColMasterCellPhone).Value 
     RowEnteredName(LbEntryCrnt) = RowMasterCrnt 
     LbEntryCrnt = LbEntryCrnt + 1 
     Set CellName = .Columns(ColMasterFamilyName).findnext(CellName) 
     If CellName.Row = CellNameFirst.Row Then 
     Exit Do 
     End If 

    Loop 
    End With 

    Me.ListBox1.Column = ListBoxData ' Write array to listbox 
    ListBox1.Visible = True 

End Sub 
'Get the checked checkboxes as a space-separated string 
Function GetCheckBoxes() As String 

    Dim arrStakeHolderAll() As Variant 
    Dim i As Long 
    Dim rv As String 

    'Debug.Assert False 
    arrStakeHolderAll = WhatCheckboxes() 
    rv = "" 

    For i = LBound(arrStakeHolderAll) To UBound(arrStakeHolderAll) 
    'Debug.Assert False 
    If Me.Controls(arrStakeHolderAll(i)).Value = True Then 
     'Debug.Assert False 
     rv = rv & IIf(Len(rv) > 0, " ", "") & arrStakeHolderAll(i) 
    End If 
    Next i 

    GetCheckBoxes = rv 

End Function 
Sub SetCheckBoxes(strList As String) 

    ' Populate checkboxes from space-separated values in strList. 
    ' Pass "" to just clear checkboxes 

    Dim arrStakeHolderAll() As Variant 
    Dim arrStakeHolderCrnt() As String 
    Dim i As Long 
    Dim tmp As String 

    'Debug.Assert False 
    PACT.Value = False 
    PrinceRupert.Value = False 
    WPM.Value = False 
    Montreal.Value = False 
    TET.Value = False 
    TC.Value = False 
    US.Value = False 
    Other.Value = False 

    arrStakeHolderAll = WhatCheckboxes() 

If Len(strList) > 0 Then 
    'Debug.Assert False 
    arrStakeHolderCrnt = Split(strList, " ") 
    For i = LBound(arrStakeHolderCrnt) To UBound(arrStakeHolderCrnt) 
     'Debug.Assert False 
     tmp = Trim(arrStakeHolderCrnt(i)) 
     If Not IsError(Application.Match(tmp, arrStakeHolderAll, 0)) Then 
     'Debug.Assert False 
     Me.Controls(tmp).Value = True 
     End If 
    Next i 
    End If 

End Sub 

'returns the name of all Stakeholder checkboxes 
Function WhatCheckboxes() As Variant() 
    'Debug.Assert False 
    WhatCheckboxes = Array("PACT", "PrinceRupert", "WPM", _ 
         "Montreal", "TET", "TC", "US", "Other") 
End Function