中文字幕理论片,69视频免费在线观看,亚洲成人app,国产1级毛片,刘涛最大尺度戏视频,欧美亚洲美女视频,2021韩国美女仙女屋vip视频

每一次都在孤單徘徊中堅(jiān)強(qiáng)，每一次就算很受傷也不閃淚光，我知道我一直有雙隱形的翅膀，帶我飛飛過絕望…………

聽首歌，都好好的……

我們今天聊的內(nèi)容是單元格的數(shù)據(jù)有效性（2010版本后更名為數(shù)據(jù)驗(yàn)證），在EH論壇上，星光經(jīng)常碰到網(wǎng)友提問下面醬紫的問題：

如何創(chuàng)建去除重復(fù)項(xiàng)后的下拉列表？

舉個(gè)小栗子。

如下圖所示，D列是一些人名，含有重復(fù)項(xiàng)。

現(xiàn)在需要根據(jù)D列的人名，在表格的A列創(chuàng)建去除重復(fù)人名后的數(shù)據(jù)驗(yàn)證下拉列表。

動畫效果：

代碼如下：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Intersect([a:a], Target) Is Nothing Then Exit Sub

    '如果選擇的單元格不存在于A列，則退出。A列是設(shè)置數(shù)據(jù)驗(yàn)證的區(qū)域

    If Target.Rows.Count > 1 Then Exit Sub '不允許選擇多行

    Dim arr, brr, i&, j&, k&, s

    Dim d As Object

    Set d = CreateObject('scripting.dictionary') '后期字典

    arr = Range('d1:d' & Cells(Rows.Count, 'd').End(xlUp).Row) '數(shù)據(jù)來源列

    If Not IsArray(arr) Then Exit Sub

    '如果不存在數(shù)據(jù)源選項(xiàng)，則arr非數(shù)組，那么退出程序

    For i = 2 To UBound(arr)

    'D1是標(biāo)題，從第2行開始遍歷數(shù)據(jù)源，將人名裝入字典

        If arr(i, 1) <> '' Then d(arr(i, 1)) = ''

    Next

    s = Join(d.keys, ',')

    With Target.Validation

        .Delete'刪掉舊的

        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _

        Operator:=xlBetween, Formula1:=s 'S為數(shù)據(jù)驗(yàn)證的序列來源

    End With

    Application.SendKeys '%{down}'

    'SendKeys發(fā)出快捷鍵atl ↓直接彈出數(shù)據(jù)驗(yàn)證下拉列表

    Set d = Nothing '釋放字典

End Sub

小貼士：

1，代碼需要粘貼在相關(guān)工作表標(biāo)簽所對應(yīng)的VBE窗口中。

2，代碼使用了Worksheet_SelectionChange事件，當(dāng)鼠標(biāo)點(diǎn)擊A列單元格時(shí)，系統(tǒng)自動運(yùn)行該段代碼?？梢酝ㄟ^修改Intersect([a:a], Target)中的[a:a]，設(shè)置為其它目標(biāo)區(qū)域。

3，代碼使用了 Application.SendKeys '%{down}'語句，其意思是鍵盤輸入快捷鍵alt ↓，該快捷鍵可能會和電腦的其它熱鍵沖突，該語句并不是必須的，因此部分親們可以注釋掉它。

4，握爪~晚安啦~

一碼不掃，
可以掃天下？

ExcelHome

VBA編程學(xué)習(xí)與實(shí)踐