VBA示例程序：筛选并获取不重复日期

完美Excel · 公众号 · · 2024-05-12 13:55

正文

学习Excel技术，关注微信公众号：

excelperfect

标签：VBA

如下图1所示，在名为“工作簿1.xlsm”的工作簿的工作表Sheet1中，标题为“StartDate”的列有一系列日期，但其中有很多重复的日期，现在要对其进行筛选，获取不重复日期，示例结果如图1中的列C所示。

图1

打开VBE，插入一个标准模块，在其中输入代码：

Sub GetDates() Const adOpenStatic = 3 Const adLockOptimistic = 3 Const adCmdText = &H1 Dim cn As Object, rs As Object Set cn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset")  cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _   "Data Source=" & ThisWorkbook.FullName & ";" & _   "Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1;TypeGuessRows=0;ImportMixedTypes=Text"""  rs.Open "SELECT DISTINCT [Sheet1$].[StartDate] FROM [Sheet1$] WHERE NOT [Sheet1$].[StartDate] IS NULL", cn, adOpenStatic, adLockOptimistic, adCmdText Worksheets("Sheet1").Range("C2").CopyFromRecordset rs rs.MoveFirst Do While Not rs.EOF   Debug.Print rs(0)   rs.MoveNext LoopEnd Sub

运行后的结果如上图1中列C所示。

上面的代码可供有兴趣的朋友研究，主要是在VBA中运用了数据库技术。

其实，不用那么麻烦，几行代码就可以搞定。代码如下：

Sub FilterDates()  Worksheets("Sheet1").Range("A:A").Copy Worksheets("Sheet1").Range("C1")  Application.CutCopyMode = False   Application.DisplayAlerts = False  Worksheets("Sheet1").Range("$C:$C").RemoveDuplicates Columns:=1, Header:=xlYes  Application.DisplayAlerts = TrueEnd Sub