VBA 引用列创建无重复值下拉列表

2019-02-18

Refer to this article.
Refer to New

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim RowNum, ListRows, ListStartRow, ListColumn As Integer
    Dim TheList As String
    Dim Repeated As Boolean
    Dim myRange As Range
    Set myRange = Worksheets("Sheet1").Range("A2:A65535")
    If Target.Address <> "$B$2" Then Exit Sub
    With myRange
       ListRows = .Rows.Count
       ListStartRow = .Row
       ListColumn = .Column
    End With
    For RowNum = 0 To ListRows - 1
       Repeated = False
       If Not IsEmpty(myRange.Cells(ListStartRow + RowNum, ListColumn)) Then
         For i = 0 To RowNum - 1
           If myRange.Cells(ListStartRow + RowNum, ListColumn) = myRange.Cells(ListStartRow + i, ListColumn) Then
             Repeated = True
             Exit For
           End If
         Next i
         If Not Repeated Then TheList = TheList & myRange.Cells(ListStartRow + RowNum, ListColumn) & ","
       End If
    Next RowNum
    TheList = Left(TheList, Len(TheList) - 1)
    With Range("B2").Validation
       .Delete
       .Add _
       Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=TheList
    End With
 End Sub

    Dim RowNumB, ListRowsB, ListStartRowB As Integer
    Dim TheBList As String
    Dim rangeB As Range
    Dim nameParam As Range
    
    Set rangeB = Worksheets("Sheet1").Range("A2:B65536")
    Set nameParam = Range("A2")
    
    If Target.Address = "$B$2" Then
       If nameParam.Value = Null Or nameParam.Value = "" Then
       Exit Sub
       End If
       
       With rangeB
           ListRowsB = .Rows.Count
           ListStartRowB = 1
       End With
       
       For RowNumB = 0 To ListRowsB - 1
           If Not IsEmpty(rangeB.Cells(ListStartRowB + RowNumB, 1)) Then
             If rangeB.Cells(ListStartRowB + RowNumB, 1) = nameParam.Value And Not IsEmpty(rangeB.Cells(ListStartRowB + RowNumB, 2)) Then
               TheBList = TheBList & rangeB.Cells(ListStartRowB + RowNumB, 2) & ","
             End If
           End If
       Next RowNumB
       
       TheBList = Left(TheBList, Len(TheBList) - 1)
        With Range("B2").Validation
           .Delete
           .Add _
           Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=TheBList
        End With
    End If