EXCEL自动筛选,即分类,用VBA

发布网友 发布时间：2023-08-20 01:50

我来回答

共3个回答

热心网友 时间：2023-08-22 00:51

在随便那个工作表标签上(就是显示“原表”、“高系列”等等的地方)，右键单击，选择“查看代码(V)”,在打开的VBA编辑窗口里双击左边的ThisWorkBook，然后在右边把下面的代码贴进去就达到你的目的了，记得要存盘，还有打开工作簿时如果提示是否运行宏，一定要让它运行：
Private Sub Workbook_Open()
Application.DisplayAlerts = False
Set 原表 = Sheets("原表")
For Each 表格 In Sheets
If 表格.Name <> 原表.Name Then 表格.Delete
Next
开始行 = ActiveSheet.UsedRange.Row + 1
结束行 = 开始行 + ActiveSheet.UsedRange.Rows.Count - 2
For 行号 = 开始行 To 结束行
类型 = 原表.Cells(行号, 1)
If 类型 <> "" Then
On Error GoTo 错误处理
Set 目的表 = Sheets(Left(类型, 1) & "系列")
On Error GoTo 0
末行 = 目的表.Cells.SpecialCells(xlCellTypeLastCell).Row
If 末行 <> 1 Or 目的表.Cells(末行, 1) <> "" Then 末行 = 末行 + 1
原表.Rows(行号).Copy 目的表.Cells(末行, 1)
End If
Next
Application.DisplayAlerts = True
Exit Sub
错误处理:
If Err.Number = 9 Then
Sheets.Add , ActiveSheet
ActiveSheet.Name = Left(类型, 1) & "系列"
End If
Resume
End Sub

热心网友 时间：2023-08-22 00:51

在原来的地方实现比较麻烦, 新增个工作表来实现

Sub test()
Dim Cnn
Dim Sql As String
Set Cnn = CreateObject("ADODB.Connection")
Cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=yes';data source=" & ThisWorkbook.FullName
Sheets.Add
Range("a1:c1") = Sheet1.Range("a1:c1").Value
Sql = "select * from [sheet1$] where 分类 in ('A','B','C','D') and 日期 >=#2008-01-01# and 日期 <=#2008-01-31# "
Range("A2").CopyFromRecordset Cnn.Execute(Sql)
Columns("C:C").Select
Selection.NumberFormatLocal = "yyyy/m/d"
End Sub

热心网友 时间：2023-08-22 00:52

分数可观，你的例表文件也很可观啊！