excel怎么通过日期筛选数据 Excel:如何筛选重复日期

No.1

Excel操作过程当中,有时我们需要把某一个字段的数据进行列表处理,也就要做成列表,但是又不想数据重复,这就需要把Excel 数据表中重复的数据进行筛选。

本节就介绍一下,如何利用VBA代码来进行数据列表筛选,然后将筛选出的数据制作成数据验证列表。

excel怎么通过日期筛选数据 Excel:如何筛选重复日期(1)

下图为本节示例,将左侧日期列表中有重要项的筛选过滤掉,然后在右侧列出,制作成一个数据验证下拉列表,红色日期就是最终完成结果单元格。

excel怎么通过日期筛选数据 Excel:如何筛选重复日期(2)

做这个的目的就是在一列中,把重复项目选出来,为下拉列表进行填充,以供使用下拉选择。

在一些选择框中,会经常用到,所以这个取重复项目还是很有用的。

No.2

实例代码

本例中,代码包括三个部分:

  1. 主调用过程 CommandButton1_Click
  2. 新建数据验证列表函数 addNewValidation()
  3. 返回数组地址 getCellsArr()

excel怎么通过日期筛选数据 Excel:如何筛选重复日期(3)

接下来,分别代码如下:

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 = True End With End Sub

addNewValidation()函数实现新建一个数据验证列,两个参数,RangeAddr为新建验证的单元格,cellsAddress为验证列表的地址,这个参数我们使用另一个函数返回。

excel怎么通过日期筛选数据 Excel:如何筛选重复日期(4)

3、返回筛选后日期数据表地址

Function getCellsArr(s As Worksheet, cell As String) As String '返回地址 On Error Resume Next Dim w As Worksheet Set w = ActiveSheet Dim R As range, Rowi As Long w.UsedRange.Rows.Hidden = False Rowi = w.range(cell & w.Cells.Rows.Count).End(xlUp).Row Set R = w.range(cell & "4:" & cell & Rowi) Dim xR As range, xRArr() As Date, xi As Integer, xA As Variant, isEq As Boolean xi = 0 isEq = False ReDim xRArr(xi) For Each xR In R For Each xA In xRArr If xA = xR.Value Then isEq = True Exit For End If Next xA If Not isEq Then ReDim Preserve xRArr(xi) xRArr(xi) = xR.Value xi = xi 1 End If isEq = False Next xR s.range("C:C").ClearContents s.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 = Nothing Set w = Nothing getCellsArr = R.Address Set R = Nothing Erase xRArr End Function

本函数在使用过程中需要一些微小改动,由于不同的数据表保存位置不同所以函数中的一些处理结果也不会相同。如果是一张空表,也就不用更改,可以直接使用。

看上去这么多代码,其实实现的功能最终并不会显得十分复杂,甚至根本感觉不到发生了什么变化,但就是这些微小的变化,可以使我们的工作更加便捷。

欢迎关注、收藏

---END---

,

免责声明:本文仅代表文章作者的个人观点,与本站无关。其原创性、真实性以及文中陈述文字和内容未经本站证实,对本文以及其中全部或者部分内容文字的真实性、完整性和原创性本站不作任何保证或承诺,请读者仅作参考,并自行核实相关内容。文章投诉邮箱:anhduc.ph@yahoo.com

    分享
    投诉
    首页