Excel "스마트"드롭 다운 / 데이터 유효성 검사

Excel에서는 드롭 다운 메뉴 또는 데이터 유효성 검사 필드를 만드는 방법이 있습니까?

• 사용자가 현재 콤보 상자와 같이 목록에없는 값을 입력 할 수 있습니다.
• 드롭 다운 목록에 해당 값을 저장하면 사용자가 새 필드에서 해당 목록을 위로 당겨 드롭 다운에 새 값이 표시됩니다.
• 드롭 다운에서 중복 항목을 제거합니다 (예 : 사용자가 열 "Apple"을 여러 번 입력 한 경우 드롭 다운에 한 번만 나타납니다)
• (선택 사항) 드롭 다운을 알파벳 순으로 정렬

내가 먼저 시도한 것은 데이터 유효성 검증을 컬럼에 적용하고,이를리스트로 설정하고,리스트 소스를 동일한 컬럼으로 설정하는 것이었다. 이것은 처음 두 글 머리 기호를 처리하지만 불행히도이 방법을 사용하면 열에서 사용될 때마다 각 값을 복제합니다 (목록을 잘 정렬하지도 않음).

어떤 도움을 주셔서 감사합니다!

다음 코드는 콤보 목록 (데이터 유효성 검사)을 생성하고 :

• 사용자가 현재 목록에없는 값을 입력 할 수 있습니다.
• 모든 새 값을 드롭 다운 목록에 추가합니다.
• 중복 된 항목을 제거합니다.
• 목록의 모든 값을 잘라냅니다.
• 목록을 사전 순으로 정렬합니다.

코드를 붙여 넣을 위치 :

• VBA 편집기를 엽니 다. Alt + F11

  1. 첫 번째 하위 Worksheet_Change() 에 삽입되어야한다. 시트의 VBA 모듈

• 다른 모든 하위 및 기능 (섹션 1 및 2)은 새 VBA 모듈에 붙여 넣어 야합니다.

  2. 편집기 클릭 메뉴에서 끼워 넣다 & gt; 기준 치수 새 코드 붙여 넣기

.

에서 Sheet1 모듈 (Microsoft Excel 개체, VBA 편집기 왼쪽 상단) :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Columns.Count = 1 Then setList Target
End Sub

.

1 / 2 (새 VBA 모듈) :

Option Explicit

Public Sub setList(ByRef rng As Range, Optional fullColumn As Boolean = True)
   Dim ws As Worksheet, lst As Range, lr As Long

   If rng.Columns.Count = 1 Then
      xlEnabled False
      Set ws = rng.Parent
      Set lst = ws.UsedRange.Columns(rng.Column)
      lr = setLastRow(lst, rng.Column)
      If lr > 1 Then
         If fullColumn Then Set lst = ws.Columns(rng.Column)
         With lst.Validation
            .Delete
            .Add Type:=xlValidateList, Formula1:=getDistinct(lst, lr)
            .ShowError = False
         End With
      End If
      xlEnabled True
   End If
End Sub

Private Function setLastRow(ByRef rng As Range, ByVal lc As Long) As Long
   Dim ws As Worksheet, lr As Long
   If Not rng Is Nothing Then
      Set ws = rng.Parent
      lr = ws.Cells(rng.Row + ws.UsedRange.Rows.Count + 1, lc).End(xlUp).Row
      Set rng = ws.Range(ws.Cells(1, lc), ws.Cells(lr, lc)) 'updates rng (ByRef)
   End If
   setLastRow = lr
End Function

Public Sub xlEnabled(ByVal onOff As Boolean)
    Application.ScreenUpdating = onOff
    Application.EnableEvents = onOff
End Sub

2/2 :

Private Function getDistinct(ByRef rng As Range, ByVal lr As Long) As String
   Dim ws As Worksheet, lst As String, lc As Long, tmp As Range

   Set ws = rng.Parent
   lc = ws.Cells(rng.Row, rng.Column + ws.UsedRange.Columns.Count + 1).End(xlToLeft).Column
   Set tmp = ws.Range(ws.Cells(1, lc + 1), ws.Cells(lr, lc + 1))

   If tmp.Count > 1 Then
      With tmp.Cells(1, 1)
         .Formula = "=Trim(" & ws.Cells(rng.Row, lc).Address(False, False) & ")"
         .AutoFill Destination:=tmp
      End With

      tmp.Value2 = tmp.Value2
      tmp.RemoveDuplicates Columns:=1, Header:=xlNo
      lr = setLastRow(tmp, lc + 1)

      ws.Sort.SortFields.Add Key:=ws.Cells(lr + 1, lc + 1), Order:=xlAscending
      With ws.Sort
         .SetRange tmp
         .Header = xlNo
         .MatchCase = False
         .Orientation = xlTopToBottom
         .Apply
      End With

      setLastRow tmp, lc + 1
      lst = Join(Application.Transpose(tmp), ",")
      tmp.Cells(1, 1).EntireColumn.Delete
   End If

   getDistinct = lst

End Function

새 값을 입력 할 때마다 (모든 열에서)

• 이 코드는 ScreenUpdating 및 이벤트를 일시적으로 사용 중지합니다.
• 현재 열의 이전 데이터 유효성 검사가 제거됩니다.
• 시트에서 마지막으로 사용한 열과 현재 열의 데이터가있는 마지막 셀을 결정합니다.

• 드롭 다운을 전체 열에 적용할지 또는 데이터가있는 셀에만 적용 할지를 확인합니다.

  • 이 옵션은 변경하여 전환 할 수 있습니다. fullColumn As Boolean = True 에 False

• 함수 getDistinct () :

  • 현재 열의 모든 값을 시트의 첫 번째 사용되지 않은 열에 복사합니다.
  • 이것은 일반적인 복사 \ 붙여 넣기 작업이 아닙니다.
  • 현재 열의 모든 셀에 대해 TRIM ()을 새 열에 적용합니다.
  • 그런 다음 수식 결과를 문자열로 변환합니다.
  • 적용하다 RemoveDuplicates 이 새로운 범위로만
  • 나머지 목록에 정렬 ​​적용
  • 목록 크기를 다시 결정하고 쉼표로 구분 된 항목 문자열로 범위를 변환합니다.

• Sub setList ()는 드롭 다운을 생성하는 새로운 유효성 검사 규칙에 목록을 적용합니다.

  • 이 유효성 검사 규칙은 데이터 & gt; 데이터 유효성 검사 (열 선택 및 모두 지우기)

• 한 줄을 주석 처리하여 해제 할 수 있습니다.

.

Private Sub Worksheet_Change(ByVal Target As Range)
   'If Target.Columns.Count = 1 Then setList Target
End Sub