网站首页 > 资源文章 正文
Excel自带筛选功能,如:
但:无法快速、组合筛选。
编一个模块如下:
选中希望筛选的列(任意单元格),运行后显示:
当再次载入时,可以读取上次选中的项,便于二次筛选。
所的的代码如下:
Private Sub UserForm_Initialize()
Dim currentCell As Range
Dim uniqueValues As Collection
Dim rng As Range
Dim i As Long
Dim lvItem As ListItem
Dim ws As Worksheet
Dim rowIndex As Long
Me.ListView1.ColumnHeaders.Add , , "序号", 60
Me.ListView1.ColumnHeaders.Add , , "单元格值", Me.ListView1.Width - 70
Me.ListView1.View = lvwReport
Me.ListView1.FullRowSelect = True
Me.ListView1.CheckBoxes = True
Me.ListView1.LabelEdit = lvwAutomatic
' 获取当前工作表和当前选中单元格
Set ws = ActiveWorkbook.ActiveSheet
Set currentCell = ws.Cells(ActiveCell.row, ActiveCell.Column)
' 获取当前列,不包括第一行
Set rng = ws.Cells(ActiveCell.currentRegion.Range("A1").row, ActiveCell.Column).Resize(ActiveCell.currentRegion.Rows.Count - 1, 1).Offset(1, 0) ' 忽略第一行
' 创建集合来存储唯一值
Set uniqueValues = New Collection
On Error Resume Next
Dim cell As Range
For Each cell In rng
If cell.Value <> "" Then
uniqueValues.Add cell.Value, CStr(cell.Value)
End If
Next cell
On Error GoTo 0
' 填充
ListView1.ListItems.Clear
For i = 1 To uniqueValues.Count
Set lvItem = ListView1.ListItems.Add(, , Format(i, "000")) ' 第一列,000格式序号
lvItem.SubItems(1) = uniqueValues(i) ' 第二列,唯一值
Next i
' 找到显示值
Set uniqueValues = New Collection
On Error Resume Next
For Each cell In rng
If ws.Rows(cell.row).Hidden = False Then
uniqueValues.Add cell.Value, CStr(cell.Value)
End If
Next cell
On Error GoTo 0
' 标识ListViewItem
For Each lvItem In ListView1.ListItems
If IsInCollection(uniqueValues, lvItem.ListSubItems(1).text) Then
lvItem.Checked = True
End If
Next lvItem
End Sub
Private Sub CheckBox1_Click()
Dim objListViewItem As ListItem
If Me.CheckBox1.Value Then
For Each objListViewItem In Me.ListView1.ListItems
objListViewItem.Checked = True
Next
Else
For Each objListViewItem In Me.ListView1.ListItems
objListViewItem.Checked = False
Next
End If
End Sub
Private Sub 确定_Click()
Dim selectedItems As Collection
Dim lvItem As ListItem
Dim rng As Range
Dim ws As Worksheet
Dim cell As Range
Dim currentRegion As Range
Dim currentCol As Long
Dim firstDataRow As Long
Dim totalRows As Long
Set ws = ActiveWorkbook.ActiveSheet
currentCol = ActiveCell.Column
' 获取当前单元格所在区域,不包括第一行
Set currentRegion = ActiveCell.currentRegion
firstDataRow = currentRegion.row + 1
totalRows = currentRegion.Rows.Count - 1
' 创建集合,存储选中的ListView Item
Set selectedItems = New Collection
For Each lvItem In ListView1.ListItems
If lvItem.Checked Then
selectedItems.Add lvItem.SubItems(1)
End If
Next lvItem
' 如果没有选中,取消隐藏所有
If selectedItems.Count = 0 Then
currentRegion.Rows.Hidden = False
Exit Sub
End If
' 使用Resize调整范围
Application.ScreenUpdating = False
ActiveCell.currentRegion.Range("A1").Select
Set rng = ws.Cells(ActiveCell.currentRegion.Range("A1").row, currentCol).Resize(totalRows, 1).Offset(1, 0) ' 忽略第一行
For Each cell In rng.Cells
If Not IsEmpty(cell.Value2) And VarType(cell.Value2) <> vbError Then
If CStr(cell.Value2) <> "" Then
If Not IsInCollection(selectedItems, cell.Value2) Then
cell.EntireRow.Hidden = True
Else
cell.EntireRow.Hidden = False
End If
End If
End If
Next cell
Application.ScreenUpdating = True
End Sub
' 判断值是否在集合中
Private Function IsInCollection(col As Collection, val As Variant) As Boolean
Dim item As Variant
For Each item In col
If item = val Then
IsInCollection = True
Exit Function
End If
Next item
IsInCollection = False
End Function
Private Sub 添加_Click()
' 可以多次添加,较系统自动筛选,更易于使用
' 适用多个场景
Dim lvItem As ListItem
Dim strKeyWord As String
strKeyWord = Trim(Me.TextBoxKeyWord.text)
If strKeyWord = "" Then Exit Sub
For Each lvItem In ListView1.ListItems
If InStr(1, lvItem.ListSubItems(1).text, strKeyWord) > 0 Then
lvItem.Checked = True
End If
Next lvItem
End Sub
猜你喜欢
- 2024-12-10 一个监控PLC的Android应用的开发过程-2
- 2024-12-10 android学习,listview
- 2024-12-10 ListView和RecyclerView的区别
- 2024-12-10 轻松学会:滑动组件ListView和GridView的使用
- 2024-12-10 常见面试题之ListView的复用及如何优化
- 2024-12-10 那些技术—Listview的性能提高篇
- 2024-12-10 Excel VBA,通过ListView查阅工作表数据、外部数据源数据(1/5)
- 2024-12-10 Android中ListView的使用方法
- 2024-12-10 PC SDK二次开发:基于C#语言编写的ABB机器人控制器扫描程序
- 2024-12-10 Excel vba 如何导入导出工作表,数据管理方法介绍
你 发表评论:
欢迎- 07-09一文读懂OSS、NAS、EBS有什么区别?
- 07-09如何检测 Linux 硬盘上的坏扇区或坏块?
- 07-09线上问题排查:接口超时(接口超时是什么问题)
- 07-09玩转 Linux 之:磁盘分区、挂载知多少?
- 07-09Linux文件系统对比:XFS、EXT4、Btrfs和ZFS详细比较
- 07-09存储基础篇之硬盘二(工作原理)(硬盘的存储原理)
- 07-09Openwrt 常用包(openwrt常用功能)
- 07-09C 语言源程序文件扩展名及相关知识详解
- 最近发表
- 标签列表
-
- 电脑显示器花屏 (79)
- 403 forbidden (65)
- linux怎么查看系统版本 (54)
- 补码运算 (63)
- 缓存服务器 (61)
- 定时重启 (59)
- plsql developer (73)
- 对话框打开时命令无法执行 (61)
- excel数据透视表 (72)
- oracle认证 (56)
- 网页不能复制 (84)
- photoshop外挂滤镜 (58)
- 网页无法复制粘贴 (55)
- vmware workstation 7 1 3 (78)
- jdk 64位下载 (65)
- phpstudy 2013 (66)
- 卡通形象生成 (55)
- psd模板免费下载 (67)
- shift (58)
- localhost打不开 (58)
- 检测代理服务器设置 (55)
- frequency (66)
- indesign教程 (55)
- 运行命令大全 (61)
- ping exe (64)
本文暂时没有评论,来添加一个吧(●'◡'●)