Excel:如何篩選重複日期，建立資料驗證列表，高階進階

No.1

Excel操作過程當中，有時我們需要把某一個欄位的資料進行列表處理，也就要做成列表，但是又不想資料重複，這就需要把Excel 資料表中重複的資料進行篩選。

本節就介紹一下，如何利用VBA程式碼來進行資料列表篩選，然後將篩選出的資料製作成資料驗證列表。

下圖為本節示例，將左側日期列表中有重要項的篩選過濾掉，然後在右側列出，製作成一個數據驗證下拉列表，紅色日期就是最終完成結果單元格。

做這個的目的就是在一列中，把重複項目選出來，為下拉列表進行填充，以供使用下拉選擇。

在一些選擇框中，會經常用到，所以這個取重複項目還是很有用的。

No.2

例項程式碼

本例中，程式碼包括三個部分：

主呼叫過程 CommandButton1_Click新建資料驗證列表函數 addNewValidation()返回陣列地址 getCellsArr()

接下來，分別程式碼如下：

1、主呼叫過程

Private Sub CommandButton1_Click()

Dim R As range

Set R = ActiveSheet.range("B3")

Call addNewValidation(R, getCellsArr(ActiveSheet, "B"))

End Sub

這個程式碼放到按鈕單擊事件裡，當然可以放到任何事件當中，主要看程式的需要。

主過程呼叫的是函數addNewValidation()函數，其有兩個參數，要設定正確，一個是日期列工作表，另一個是工作表列名。

2、新建資料驗證列表函數 addNewValidation()

Sub addNewValidation(RangeAddr As range, cellsAddress As String)'新建資料驗證列表With RangeAddr.Validation.Delete.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _xlBetween, Formula1:="=" & cellsAddress.IgnoreBlank = True.InCellDropdown = True.InputTitle = "".ErrorTitle = "".InputMessage = "".ErrorMessage = "".IMEMode = xlIMEModeNoControl.ShowInput = True.ShowError = TrueEnd WithEnd Sub

addNewValidation()函數實現新建一個數據驗證列，兩個參數，RangeAddr為新建驗證的單元格，cellsAddress為驗證列表的地址，這個參數我們使用另一個函數返回。

3、返回篩選後日期資料表地址

Function getCellsArr(s As Worksheet, cell As String) As String '返回地址On Error Resume NextDim w As WorksheetSet w = ActiveSheetDim R As range, Rowi As Longw.UsedRange.Rows.Hidden = FalseRowi = w.range(cell & w.Cells.Rows.Count).End(xlUp).RowSet R = w.range(cell & "4:" & cell & Rowi)Dim xR As range, xRArr() As Date, xi As Integer, xA As Variant, isEq As Booleanxi = 0isEq = FalseReDim xRArr(xi)For Each xR In RFor Each xA In xRArrIf xA = xR.Value ThenisEq = TrueExit ForEnd IfNext xAIf Not isEq ThenReDim Preserve xRArr(xi)xRArr(xi) = xR.Valuexi = xi + 1End IfisEq = FalseNext xRs.range("C:C").ClearContentss.range("C4").Value = "搜尋日期"Set R = s.range("C5:C" & UBound(xRArr) + 5)R.Value = Application.WorksheetFunction.Transpose(xRArr)R.Interior.Color = QBColor(11)Set s = NothingSet w = NothinggetCellsArr = R.AddressSet R = NothingErase xRArrEnd Function

本函數在使用過程中需要一些微小改動，由於不同的資料表儲存位置不同所以函數中的一些處理結果也不會相同。如果是一張空表，也就不用更改，可以直接使用。

看上去這麼多程式碼，其實實現的功能最終並不會顯得十分複雜，甚至根本感覺不到發生了什麼變化，但就是這些微小的變化，可以使我們的工作更加便捷。

歡迎關注、收藏

---END---