이중 목차(선택하는 것에 따라 내용 변경,같은것은 목록으로)(주소/전화번호)

이중 목차 선택하는거에 따라 내용이 변경되게 하고 싶다.
if문의 한계 때문에 바로바로 변경안되어서

G1값(사는곳)이 변경되면 자동으로 H1값에 이름이 나오고 I1값이 전화번호나오게

단 H1 이름값이 여러개 일때는 목록으로 나오게

순서

1.  개발도구->Visual Basic

2.  sheet 선택(더블클릭)

3. 코드 입력

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim G1 As Range, H1 As Range, I1 As Range
    Dim NameList As Collection
    Dim FilteredNames As String
    Dim cell As Range
    Dim SelectedPlace As String
    
    ' 시트 참조
    Set ws = Me
    Set G1 = ws.Range("G1") ' 사는 곳 선택
    Set H1 = ws.Range("H1") ' 이름 표시
    Set I1 = ws.Range("I1") ' 전화번호 표시
    
    ' G1 셀이 변경되었을 때 실행 (사는 곳을 선택)
    If Not Intersect(Target, G1) Is Nothing Then
        Application.EnableEvents = False ' 이벤트 중첩 방지
        
        ' 초기화
        H1.Validation.Delete ' 기존 데이터 유효성 삭제
        H1.Value = ""
        I1.Value = ""
        Set NameList = New Collection
        FilteredNames = ""
        
        ' 선택된 사는 곳
        SelectedPlace = G1.Value
        
        ' 사는 곳에 해당하는 이름과 전화번호 가져오기
        For Each cell In ws.Range("C2:C" & ws.Cells(ws.Rows.Count, "C").End(xlUp).Row)
            If cell.Value = SelectedPlace Then
                ' 같은 행의 B열 이름 추가
                On Error Resume Next ' 중복 방지
                NameList.Add ws.Cells(cell.Row, "B").Value
                On Error GoTo 0
            End If
        Next cell
        
        ' 이름 리스트를 콤마(,)로 연결
        Dim i As Integer
        For i = 1 To NameList.Count
            FilteredNames = FilteredNames & NameList(i) & ","
        Next i
        
        ' 마지막 콤마 제거
        If Len(FilteredNames) > 0 Then FilteredNames = Left(FilteredNames, Len(FilteredNames) - 1)
        
        ' 이름이 여러 개면 드롭다운 목록 추가
        If NameList.Count > 1 Then
            With H1.Validation
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                     Operator:=xlBetween, Formula1:=FilteredNames
                .IgnoreBlank = True
                .InCellDropdown = True
            End With
            ' 첫 번째 이름을 기본값으로 설정
            H1.Value = NameList(1)
        ElseIf NameList.Count = 1 Then
            ' 이름이 하나만 있으면 자동 표시
            H1.Value = NameList(1)
        End If
        
        ' 이름이 선택되면 전화번호 자동 업데이트
        Call UpdatePhoneNumber
        
        Application.EnableEvents = True ' 이벤트 재활성화
    End If
    
    ' H1 셀이 변경되었을 때 전화번호 업데이트
    If Not Intersect(Target, H1) Is Nothing Then
        Call UpdatePhoneNumber
    End If
End Sub

Sub UpdatePhoneNumber()
    Dim ws As Worksheet
    Dim H1 As Range, I1 As Range
    Dim cell As Range
    
    ' 시트 참조
    Set ws = Me
    Set H1 = ws.Range("H1") ' 이름 선택
    Set I1 = ws.Range("I1") ' 전화번호 표시
    
    ' 이름에 해당하는 전화번호 찾기
    If H1.Value <> "" Then
        For Each cell In ws.Range("B2:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)
            If cell.Value = H1.Value Then
                I1.Value = ws.Cells(cell.Row, "D").Value
                Exit For
            End If
        Next cell
    Else
        I1.Value = "" ' 이름이 없을 경우 전화번호 초기화
    End If
End Sub

4. 확인

(G1 셀 값이 변경시 이름과 주소 나오는지 확인)

5. 파일 참조

123.xlsm

0.02MB