精华内容
下载资源
问答
  • vba编程筛选代码
    2022-06-01 15:02:40

    Excel VBA 编程,在表格做自动筛选的功能

    下面的例子是自动筛选85列的内容,筛选内容为处方

    Private Sub CommandButton11_Click()
        '筛选处方
        If Sheet1.AutoFilterMode = False Then  '检查是否开启自动筛选
            lastrow = Sheet1.Range("A1040000").End(xlUp).Row
            Range("A:DZ").AutoFilter   '没有开启的话则开启自动筛选
            Sheet1.Range("CG:CG").AutoFilter field:=85, Criteria1:="处方"
        Else
            Sheet1.AutoFilterMode = False
            lastrow = Sheet1.Range("A1040000").End(xlUp).Row
            Range("A:DZ").AutoFilter   '没有开启的话则开启自动筛选
            Sheet1.Range("CG:CG").AutoFilter field:=85, Criteria1:="处方"
        End If
    End Sub

    Private Sub CommandButton11_Click()
        '筛选处方
        If Sheet1.AutoFilterMode = False Then  '检查是否开启自动筛选
            lastrow = Sheet1.Range("A1040000").End(xlUp).Row
            Range("A:DZ").AutoFilter   '没有开启的话则开启自动筛选
            Sheet1.Range("CG:CG").AutoFilter field:=85, Criteria1:="处方"
        Else
            Sheet1.AutoFilterMode = False
            lastrow = Sheet1.Range("A1040000").End(xlUp).Row
            Range("A:DZ").AutoFilter   '没有开启的话则开启自动筛选
            Sheet1.Range("CG:CG").AutoFilter field:=85, Criteria1:="处方"
        End If
    End Sub

    更多相关内容
  • 滞销商品筛选.xlsx源码EXCEL VBA编程xlsx实例代码下载滞销商品筛选.xlsx源码EXCEL VBA编程xlsx实例代码下载滞销商品筛选.xlsx源码EXCEL VBA编程xlsx实例代码下载滞销商品筛选.xlsx源码EXCEL VBA编程xlsx实例...
  • 忽略重复项进行筛选.xlsx源码EXCEL VBA编程xlsx实例代码下载忽略重复项进行筛选.xlsx源码EXCEL VBA编程xlsx实例代码下载忽略重复项进行筛选.xlsx源码EXCEL VBA编程xlsx实例代码下载忽略重复项进行筛选.xlsx...
  • 筛选出货率高的商品.xlsx源码EXCEL VBA编程xlsx实例代码下载筛选出货率高的商品.xlsx源码EXCEL VBA编程xlsx实例代码下载筛选出货率高的商品.xlsx源码EXCEL VBA编程xlsx实例代码下载筛选出货率高的商品.xlsx...
  • 显示筛选过资料的数量.xlsx源码EXCEL VBA编程xlsx实例代码下载显示筛选过资料的数量.xlsx源码EXCEL VBA编程xlsx实例代码下载显示筛选过资料的数量.xlsx源码EXCEL VBA编程xlsx实例代码下载显示筛选过资料的数量...
  • 复制筛选结果到新工作表.xlsx源码EXCEL VBA编程xlsx实例代码下载复制筛选结果到新工作表.xlsx源码EXCEL VBA编程xlsx实例代码下载复制筛选结果到新工作表.xlsx源码EXCEL VBA编程xlsx实例代码下载复制筛选结果到...
  • 删除未被筛选出来的结果.xlsx源码EXCEL VBA编程xlsx实例代码下载删除未被筛选出来的结果.xlsx源码EXCEL VBA编程xlsx实例代码下载删除未被筛选出来的结果.xlsx源码EXCEL VBA编程xlsx实例代码下载删除未被筛选...
  • VBA常用代码合集

    万次阅读 多人点赞 2020-12-19 11:13:11
    VBA常用代码模版Tp0️⃣—零零散散小功能(持续更新)Tp1️⃣—输出活动页面筛选后的行数Tp2️⃣—创建数组存放数据Tp2-1 静态数组Tp2-2 动态数组Tp3️⃣ 创建字典存放数据Tp4️⃣ 优化代码运行速度 Tp0️⃣—零零散...

    Tp0️⃣—零零散散小功能(持续更新)

    • 剪切列
    • 替换字符
    • 取消复制剪切状态
    • 浮点数向上取值
    • 区域添加边框
    • 区域设置颜色
    • 调整列宽、行高
    • 待更新
    '  小功能集合
    Sub Demos()
    
    	'	剪切一列到指定列
    	With ThisWorkbook.Sheets(2)    
    		.[AI:AI].Cut    
    		.[AE:AE].Select    
    		Selection.Insert Shift:=xlToRight
    	End With
    
    	'	替换字符,将(空白)替换为空
    	With worksheet.[C:C]
    		.Replace "(空白)", ""
    	End With
    	
    	'	取消复制剪贴状态
    	Application.CutCopyMode = False
    	   
    	'	将带有小数的数据向上取整
    	NewData = Application.WorksheetFunction.RoundUp(Datas, 0)
    
    	' 	单元格区域添加边框
    	.Range("A4:N" & .Range("A9999").End(xlUp).Row).Borders.LineStyle = xlContinuous
    
    	'  -------------单元格标色-------------
    	'  指定区域标色
    	With Range("C2:G9")
        	.Interior.ColorIndex = 0	' 无填充颜色
         	.Interior.ColorIndex = 3	' 红色
         	.Interior.ColorIndex = 5	' 蓝色              
        End With
        
    	' 实现自动调整行高、列宽
    	Rows("1:5").EntireRow.AutoFit			' 调整1至5行行高
        Columns("A:AA").EntireColumn.AutoFit    ' 调整A至AA列列宽
        ' 设置行高、列宽为固定值
        Rows("1:5").RowHeight = 15				' 设置1至5行行高为15
        Columns("A:AA").ColumnWidth = 15		' 设置A至AA列列宽为15
    
    End Sub
    

    颜色索引-Range属性
    Excel颜色索引

    Tp1️⃣—输出活动页面筛选后的行数

    ' 获取活动页面筛选后的行数
    Sub RowCntAfterFilter()
    
        Dim rngCell As Range
        Dim lngRowCnt As Long
        For Each rngCell In [a1].CurrentRegion.SpecialCells(xlCellTypeVisible).Areas
            lngRowCnt = lngRowCnt + rngCell.Rows.Count
        Next rngCell
    	rows_count =  lngRowCnt - 1   '可视区行数
        MsgBox "筛选后数据行数为:" & rows_count 
        Set rngCell = Nothing
        
    End Sub
    

    Tp2️⃣—创建数组存放数据

    通过数组可以快速对数据进行处理
    前提:表格数据须规范,不考虑合并单元格
    一维数组:数字(1,2,3,4),字符串(a,b,c,d)
    二维数组:((1,1),(1,2),(1,3),(2,1),(2,2),(2,3)) 表格结构、行列转置、计算、遍历、统计…
    多维数组:不是很熟悉,不敢乱说( ̄□ ̄||)
    简单介绍静态数组动态数组的使用

    Tp2-1 静态数组

    Sub SetArray()
    	’   静态数组可直接通过 变量名=数组()的方式设置
    	array_number = Array(1,2,3,4,5)
    	array_string = Array("张三","李四","王五","Sugar","Smile")
    	
    	'  可遍历,参数:count,Index 取值:data = array_data(1)
    	'  赋值
    	.[A1:A5] = array_number 
    	.[B1:B5] = array_string
    
    	'存放单元格区域数据到数组(二维数组的快捷应用)
    	Dim arr As Variant       '定义一个Variant类型的变量,名称为arr
       	arr = Range("A1:C3").Value '将A1:C3中保存的数据存储到数组arr里
       	Range("E1:G3").Value = arr '将数组ar写入E1:G3单元格区域
    
    End Sub
    

    Tp2-2 动态数组

    Sub VimArray()
    
    	'自定义动态数组长度n,上界为0
    	Dim n As Integer
    	n = 0
    
    	Dim SupArr() As String	 ' 定义动态数组存放供应商名称
    	With ActiveSheet   
        	For i = 2 To .[A1048576].End(xlUp).Row
            	ReDim Preserve SupArr(n)		 '  给动态数组重定义一个实际的大小
            	n = n + 1
            	SupArr(n - 1) = .Cells(i, 3).Value  ' 存到动态数组里去
        	Next i
    	End With
    
    End Sub
    

    Tp3️⃣ 创建字典存放数据

    通过字典可以快速对数据进行处理
    存放键值对关系,key具有唯一性,
    参数:count,keys,values,Item
    需要创建字典对象后使用

    '与Excel单元格结合,创建字典存放数据
    Sub RngDict()
    
    	Dim DicManForm As Object
    	Set DicManForm = CreateObject("Scripting.Dictionary")
    	key_MaxRow = ActiveSheet.[A66666].End(xlUp).Row	'活动工作表A列的最后一行的行数
    	
        '对A列进行遍历
        For key_Row = 2 To key_MaxRow
        	'取A列不重复的值作为字典的key,索引值唯一
        	KeyXX = ActiveSheet.Cells(key_Row, 1).Value
         	'导入条件:不为空,不重复
         	If KeyXX <> "" And DicManForm.Exists(KeyXX) = False Then
                DicManForm.Add KeyXX, key_Row
          	End If
        Next
        '通过key值,重设对应的value,key不存在时会报错
        DicManForm(key) = value
    	Set DicManForm = Nothing
    
    End Sub
    

    Tp4️⃣ 优化代码运行速度

    为了加快代码的执行速度,最简单的方式,将代码的执行过程设置为不显示,可以在代码执行时,临时关闭后续设置:自动重算自动刷新弹窗警告
    温馨提示:以下代码需要成对出现,设置False后,末尾改回True

    Sub AppSetting()
    
    	’  程序开始
        With Application
            .ScreenUpdating = False		'  关闭屏幕刷新
            .EnableEvents = False		'  关闭事件触发
            .DisplayAlerts = False		'  关闭弹窗提示
        End With
        
        ' Your Code				'   调用程序运行的主体代码
    
    	’程序末尾
        With Application
            .ScreenUpdating = True		'  恢复屏幕刷新
            .EnableEvents = True		'  恢复事件触发
            .DisplayAlerts = True		'  恢复弹窗提示
        End With
        
    End Sub
    

    好久不见、更新继续

    Tp5️⃣ 轻松实现工作簿加密

    Sub 解除全部工作表保护()
        Dim n As Integer
        For n = 1 To Sheets.Count
            Sheets(n).Unprotect
        Next n
    End Sub
    
    Sub 为指定工作表加指定密码保护表()
        Sheet10.Protect Password:="123"
    End Sub
    
    Sub 在有密码的工作表执行代码()
        Sheets("1").Unprotect Password:=123 '假定表名为“1”,密码为“123”  打开工作表
        Range("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True   '隐藏C列空值行
        Sheets("1").Protect Password:=123    '重新用密码保护工作表
    End Sub
    

    Tp6️⃣ 通过对话框选择文件-1

    ' 设置选择文件的弹出窗口,自主选择文件
    Sub FilePicker()
        
        Open_Path = ThisWorkbook.Sheets("操作界面").[B4]
        
        '新建一个对话框对象
        Set FileDialogObject = Application.FileDialog(msoFileDialogFilePicker)
        
        '配置对话框
        With FileDialogObject
            
            .Title = "请选择目标文件所在的文件夹:"
            
            '添加判断,改变对话框默认打开的路径
            '默认打开上次的文件路径
            If Open_Path = "" Then
            .InitialFileName = "C:\"
            Else
            .InitialFileName = Open_Path
            End If
            
        End With
        
        '显示对话框
        FileDialogObject.Show
        '获取选择对话框选择的文件
        Set paths = FileDialogObject.SelectedItems
        
        With Sheets("操作界面")
            .[I:I].Clear
            file_ = paths.Item(1)       '包含绝对路径的文件名
            .[B4].Value = paths.Parent.InitialFileName      '当前文件所在目录
            .[B6].Value = Right(file_, Len(file_) - Len(paths.Parent.InitialFileName))  '获取文件
            
            '选择多个文件时,遍历所选文件,并写入I列
            If paths.Count > 1 Then
                i_Row = 2
                For Each Item In paths
                    .Range("I" & i_Row) = Item
                    i_Row = i_Row + 1
                Next
            End If
            
        End With
        
    End Sub
    
    

    Tp7️⃣ 通过对话框选择文件-2

    '通过对话框选择文件路径
    Sub FolderPicker()
        
        Open_Path = ThisWorkbook.Sheets("操作界面").[B4]
        
        '新建一个对话框对象
        Set FolderDialogObject = Application.FileDialog(msoFileDialogFolderPicker)
        
        '配置对话框
        '配置对话框
        With FolderDialogObject
            
            .Title = "请选择目标文件所在的文件夹:"
            
            '添加判断,改变对话框默认打开的路径
            '默认打开上次的文件路径
            If Open_Path = "" Then
            .InitialFileName = "C:\"
            Else
            .InitialFileName = Open_Path
            End If
            
        End With
        
        FolderDialogObject.Show '显示对话框
        
        Set paths = FolderDialogObject.SelectedItems            '获取选择对话框选择的文件夹
        Set fso = CreateObject("Scripting.filesystemobject")    '取目标文件
        Set myf = fso.getfolder(paths.Item(1))                  '从指定路径下获取文件
        
        With Sheets("操作界面")
            .[I:I].Clear
            .[B4].Value = paths.Item(1)
            
            i_Row = 2
            For Each file In myf.Files
    '            .Range("I" & i_Row) = file             '记录绝对路径+文件名
                .Range("I" & i_Row) = file.Name         '记录文件名
                i_Row = i_Row + 1
            Next
            
        End With
        
    End Sub
    
    

    Tp8️⃣ 从目录页自动跳转至明细页

    在这里插入图片描述
    **小提示:**权限分配表中的合并单元格,其中有一个小技巧,请参考另一篇针对筛选单元格的笔记
    ------------如何解决筛选时只显示第一行------------

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
        Dim Rng, oRng As Range      ' 定义变量Rng、oRng为单元格
        
        Set Rng = Range("B2:B18")   ' 设定Rng为可操作区域单元格
        Set oRng = Selection        ' 设定oRng为选中单元格
        
        '如果所选单元格在可操作区域外,退出本次运行
        If Application.Intersect(oRng, Rng) Is Nothing Then Exit Sub
    
        Application.ScreenUpdating = False
    
        ' 多选则退出,单选设置筛选值
        If Selection.Count > 1 Then Exit Sub Else AimValue = Selection.Value
        
        ' 自动跳转至目标工作表进行筛选
        With Sheets("权限分配表")
    
            If .FilterMode = True Then .ShowAllData
            .Range("A1").AutoFilter Field:=1, Criteria1:=AimValue, _
             Operator:=xlAnd
            .Activate
        
        End With
        
        Application.ScreenUpdating = True
        
    End Sub
    
    

    Tp9️⃣ 选择区域自动设置或取消值

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
        
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        
        On Error Resume Next
    
        Dim Rng, oRngs, oRng As Range     ' 定义变量Rng、oRng为单元格
        Dim Aim As String                 ' 定义变量Aim为字符串
    
        Aim = "√"                  ' 设定目标值
        
        Set Rng = Range("D2:H706")  ' 设定Rng为可操作区域单元格
        Set oRngs = Selection       ' 设定oRngs为选中单元格
        
    
    
        '如果所选单元格在可操作区域外,退出本次运行
        If Intersect(oRngs, Rng) Is Nothing Then Exit Sub
    
            
    '    Selection.FormulaR1C1 = Aim      '直接设置所选区域内的值为"√"
    
        ' 针对选择区域,有值清空,空值设定Aim
        For Each oRng In oRngs
        
            If oRng.FormulaR1C1 = "" Then oRng.FormulaR1C1 = Aim Else oRng.FormulaR1C1 = ""
    
        Next
        
        On Error GoTo 0
    
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
    
    End Sub
    
    
    
      未完待续、、、
      期待下次相遇
    
    展开全文
  • Excel VBA编程详解

    2021-05-25 07:19:25
    “Excel中VBA编程的具体实现呀”“为什么会写这个,有什么用吗?”你们也这样觉得吗?那我就来结合工作实践讲讲这个有什么用。在工程开发中,比如A同事从事汽车控制策略开发,我们都知道这是个设计与验证不断迭代的...

    e1dce16589383d7302738dd9d28ffa24.png

    周五下班,小宇问我“这期文章主题是啥”。

    “Excel中VBA编程的具体实现呀”

    “为什么会写这个,有什么用吗?”

    你们也这样觉得吗?那我就来结合工作实践讲讲这个有什么用。

    在工程开发中,比如A同事从事汽车控制策略开发,我们都知道这是个设计与验证不断迭代的过程。现在到了实车验证阶段,用can卡去车上采集信号数据,发现有些数据结果不对。现在打算从采集的数据当中筛选一些特定的工况数据,导入模型进行再次验证。可是设备采样周期设置的是10ms,半小时的数据保存在Excel中就上万行,一个个去找不太现实。这个时候我们可以用VBA编程设定具体的条件,让代码帮我们筛选出想要的数据。

    在办公室日常管理中,比如B同事负责单位人员出勤统计,需要统计本月每位员工的到岗、迟到、旷工、出差、休假等情况。偶尔一次还好,如果每个月都要做这方面工作的话,我们是不是应该考虑做个小工具一劳永逸呢?

    以上功能都可以用VBA编程实现,而且实现起来也很简单。下面就让我们来聊一聊如何实现VBA编程。(本篇仅适于VBA编程入门学习)

    本篇会出现一个高频词汇,“宏”。简单点,可以把它理解为一些程序代码的封装,来完成一些具体的操作。

    使用Excel调用VBA程序(即宏),先要进行一些设置:

    03版本Excel的操作为【工具】-【宏】-【安全性】,弹出如下菜单(图1)。我们在Excel中调用宏,需要将安全级设为中或低。设置完后重启Excel。

    127805273_1_20180320112009769

    图1 安全性设置

    WPS中的宏操作工具栏一目了然,比03版操作起来顺手很多。界面如图2所示。

    127805273_2_20180320112009863

    图2 wps宏工具栏

    下面我们以WPS10.1版本为例进行介绍,03、07版的具体操作和WPS差不太多,基本功能都是一样的。

    创建宏:

    根据宏的触发执行方式不同,创建方式也不同。宏有两种触发执行方式,一种是直接运行,另一种是和控件关联,通过按钮等控件触发程序执行。

    创建方法:

    ①直接运行的宏:点击“宏”-输入要创建的“宏”名-创建,即可。

    ②关联控件的宏:“查看代码”右侧有很多小控件可供选择,选中控件放在表中,右键可对控件的属性进行设置,左键双击可进入代码编辑窗口。如图3所示。

    127805273_3_20180320112009957

    图3 VBA代码编辑窗口

    在代码编辑窗口,我们可以查看每个sheet中的VBA程序,进入编辑窗口的方式有很多,点击VB编辑器、查看代码或Alt F11均可。

    创建宏之后,代码窗口会自动生成Private Sub…End Sub,然后我们将想要执行的操作用程序语言描述清楚填入即可。这里对Sub简单扩展一下,Sub类似我们编写程序时自定义函数Function,区别是调用Sub子程序时没有返回值,而且可以直接执行(F5或链接到按钮控件),不需要由主函数调用执行。所以,拿来处理一些任务是很方便的。

    宏代码:

    接下来讲讲VBA编程的常用命令语句。对学过C语言的人来说,这部分其实很简单,也很好学。我将主要的知识点做成了图片,如图4所示。

    127805273_4_2018032011201082

    127805273_5_20180320112010222

    127805273_6_20180320112010378

    图4 VBA编程常用命令

    注意图3,左侧WPS表格对象Sheet1(Sheet4),“Sheet1”是工作表序号,“Sheet4”是工作表名称。这里我们使用'Sheetx.Cells ( m,n )'指定单元格时,使用工作表序号。

    当我们的操作对象类型不一致时,需要用强转命令转换对象类型。在上上期《趣事-合并单元格》中,我们使用Cstr将数值型数据转为字符型,然后进行单元格内容合并。

    运行宏:

    在代码编辑窗口,按下F5程序就被执行。退出编辑窗口,如果是和控件关联的程序,点击控件按钮,程序触发执行。非控件关联程序,点击【宏】,在界面选中要执行的宏,运行即可。

    VBA编程不需要过于复杂的语句,只需要掌握基本的语言框架,能够使用一些常用基本命令,if条件选择,For/While循环执行基本就可以满足工作中的需求。如果有不清楚的指令,还可以通过录制宏来查找。所以,运用起来也很简单。

    I hear and I forget. I see and I remember. I do and I understand.

    大家如果想真正掌握VBA编程这项技能并运用到工作中,还是应该多动手实践。

    下面是开篇中讲到的运用VBA处理考勤统计的编程实例,感兴趣的可以看一下。实现功能:点击“考勤汇总”按钮,自动统计每个人的天数和工时,并设置不同的单元格颜色对工时做出标记。

    127805273_7_20180320112010488

    图5 待处理考勤表

    127805273_8_20180320112010675

    图6 处理结果

    127805273_9_20180320112010785

    127805273_10_20180320112010925

    127805273_11_2018032011201166

    图7 考勤处理代码(参考)

    篇幅有限,今天就介绍到这里吧!

    分享个好消息,这周“四杯咖啡”终于收到了微信平台的原创开通邀请,从此,我们就有自己的留言板了!哈哈,好期待谁会是第一个留言的呢?

    展开全文
  • Excel VBA 多条件筛选及汇总统计

    千次阅读 2022-04-21 08:28:49
    在日常工作中,面对Excel表格数据,为了分类进行统计,通过对表格数据筛选获取分类条目,再按条目实行汇总统计。要完成上面的工作,有人工操作和开发程序两种方法,本文通过一个实例,详细介绍这两种方法。

    Excel VBA 多条件筛选 AdvancedFilter 汇总统计 sumproduct Range与Array交换

           在日常工作中,面对Excel表格数据,为了分类进行统计,通过对表格数据筛选获取分类条目,再按条目实行汇总统计。要完成上面的工作,有人工操作和开发程序两种方法,本文通过一个有10000行数据的管线调查表,对不同管径、管材进行分类统计数量和长度,详细介绍人工操作和VBA程序开发这两种方法。


    1、人工操作方法

    1.1高级筛选

            Excel菜单:数据-高级  找开高级筛选对话框,如下图:

     

            对话框中:  方式:将筛选 结果复制到其他位置

                         列表区域: 选择需要筛选 的区域

                            复制到:筛选结果粘贴位置(没有数据的空白区域)

                         选择不重复的记录:打钩

            确定后得到的结果如下图

     1.2分类统计

            在P2单元格输入公式:=SUMPRODUCT((H:H=N2)*(I:I=O2),L:L)

            在Q2单元格输入公式:=SUMPRODUCT((H:H=N2)*(I:I=O2))

            以此类推就可以计算出所有统计数据

    2、VBA编程的方法

            虽然人工操作方法也很方便,但当我们利用程序处理一系列复杂工作的同时,要进行分类统计时,就无法使用人工操作方法了。所以还要讨论一下编程的方法。利用Excel的VBA二次开发编写程序,实现多条件筛选分类统计可以有多种方法,本文介绍宏表函数法的数组法二种方法。

    2.1宏表函数法

            宏表函数法就是人工操作法录制宏,再对宏进行修改的方法。先做统计条目的筛选,对筛选结果进行排序,最后进行统计计算。代码如下:

    Sub 多条件筛选汇总统计()  '利用宏表函数进行多条件筛选汇总统计用约:最大行设10000时0.1秒;用整列计算用时1.46秒
    Dim 筛选数据区域 As Range
    Dim 复制区域 As Range
    Dim 总长 As Double
    Sheets("Sheet1").Select
    sngStart = Timer
    Set 筛选数据区域 = Range(Cells(1, 8), Cells(10000, 9))
    Range(Cells(1, 14), Cells(30, 17)).Clear
    Set 目标区域 = Range(Cells(1, 14), Cells(1, 14))
    筛选数据区域.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=目标区域, Unique:=True
    '排序
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("N2:N10000"), SortOn:=0, Order:=1, DataOption:=0
        .SortFields.Add Key:=Range("O2:O10000"), SortOn:=0, Order:=1, DataOption:=0
        .SetRange Range("N2:O10000")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin      'xlPinYin 表示按照首字母 排序   xlStroke 表示按每个字符的笔划数量排序。
        .Apply
    End With
    i = 2
    Do While Cells(i, 14) <> ""   '利用宏表函数进行统计汇总
        '预先能知道最大值时,条件式及统计项均使用最大值,可提高运算速度,用时 0.1 秒
        Cells(i, 16) = "=SUMPRODUCT((R2C8:R20000C8=R" + Trim(str(i)) + "C14)*(R2C9:R20000C9=R" + Trim(str(i)) + "C15),R2C12:R20000C12)"
        Cells(i, 17) = "=SUMPRODUCT((R2C8:R20000C8=R" + Trim(str(i)) + "C14)*(R2C9:R20000C9=R" + Trim(str(i)) + "C15))"
        
        '预先不知道有多少行时,条件式及统计项均使用整列,会降低运算速度,用时 1.46 秒
        'Cells(i, 16) = "=SUMPRODUCT((C8:C8=R" + Trim(str(i)) + "C14)*(C9:C9=R" + Trim(str(i)) + "C15),C12:C12)"
        'Cells(i, 17) = "=SUMPRODUCT((C8:C8=R" + Trim(str(i)) + "C14)*(C9:C9=R" + Trim(str(i)) + "C15))"
        
        i = i + 1
    Loop
    Cells(i, 16) = WorksheetFunction.Sum(Range(Cells(2, 16), Cells(i - 1, 16)))
    Cells(i, 17) = WorksheetFunction.Sum(Range(Cells(2, 17), Cells(i - 1, 17)))
    Debug.Print "耗费时间: " & Timer - sngStart
    Cells(1, 14) = "管径"
    Cells(1, 15) = "材质"
    Cells(1, 16) = "长度  m"
    Cells(1, 17) = "数量"
    Cells(i, 15) = "合计:"
    End Sub

    ***利用宏表函数进行条件筛选的结果只能复制到工作表的区域内,无法利用变量接收。

            理解宏表函数的语法对于宏表函数中动态地址的处理很重要,现在解释一下统计宏表函数的含义:

     "=SUMPRODUCT((R2C8:R20000C8=R" + Trim(str(i)) + "C14)*(R2C9:R20000C9=R" + Trim(str(i)) + "C15),R2C12:R20000C12)"

            上面这句代码其实就是一段符合宏表函数语法的字符串,他等同于下面的字符串。

    =SUMPRODUCT((R2C8:R20000C8=R2C14)*(R2C9:R20000C9=R2C15),R2C12:R20000C12)

            红色部份是一个查询条件,意思是:第8列的第二行到20000行=第14列第2行,也应是说(管径=“400”)

            绿色部份也是一个查询条件,意思是:第9列的第二行到20000行=第15列第2行,也应是说(管材=“塑料”)

            黄色部份是需要统计的区域,这时是统计符合条件的管线长度。

            统计数量时,不需要统计区域。

    ***查询条件还可以更多,每个查询条件用小括号括起来,两个条件中间用“*”相连接。

    ***查询条件中,把数值转化为字符串,一定要去除两端的空串,如Trim(str(i)),否则会出错。 

    2.2数组法

            数组法是纯编程的方法,创建动态数组,筛选出唯一的统计条目,同时进行数据的统计,最后对结果进行排序,使统计结果按排序的要求顺序输出,本例是升序。代码如下:

    Sub 综合数组分类统计()    '数组排序用时约 0.14 秒,内置函数排序用时约 0.031秒。
    Dim i As Integer, j As Integer
    Dim 总长 As Double, 数量 As Integer
    Dim str(3)
    Dim DataV(), js As Integer
    On Error Resume Next
    Sheets("Sheet1").Select
    Dim sngStart As Single: sngStart = Timer
    '筛选并排序:管径分类,材质分类
    js = 0
    i = 2
    Do While Cells(i, 1) <> ""
        For j = 1 To js
            If Cells(i, 8) = DataV(0, j) And Cells(i, 9) = DataV(1, j) Then
                DataV(2, j) = DataV(2, j) + Cells(i, 12)
                DataV(3, j) = DataV(3, j) + 1
                GoTo 20
            End If
        Next
        js = js + 1
        ReDim Preserve DataV(3, js)
        DataV(0, js) = Cells(i, 8)
        DataV(1, js) = Cells(i, 9)
        DataV(2, js) = Cells(i, 12)
        DataV(3, js) = 1
    20: i = i + 1
    Loop
    
    '数组排序
    Dim m1 As String, m2 As String
    For i = 1 To js
        For j = 1 To js - 1
            m1 = DataV(0, j) + "|" + DataV(1, j)
            m2 = DataV(0, j + 1) + "|" + DataV(1, j + 1)
            If m1 > m2 Then
               str(0) = DataV(0, j): DataV(0, j) = DataV(0, j + 1): DataV(0, j + 1) = str(0)
               str(1) = DataV(1, j): DataV(1, j) = DataV(1, j + 1): DataV(1, j + 1) = str(1)
               str(2) = DataV(2, j): DataV(2, j) = DataV(2, j + 1): DataV(2, j + 1) = str(2)
               str(3) = DataV(3, j): DataV(3, j) = DataV(3, j + 1): DataV(3, j + 1) = str(3)
            End If
        Next
    Next
    Range(Cells(1, 14), Cells(js + 1, 17)).Value = Application.Transpose(DataV)
    Cells(js + 2, 16) = WorksheetFunction.Sum(Range(Cells(2, 16), Cells(i + 1, 16)))
    Cells(i + 2, 17) = WorksheetFunction.Sum(Range(Cells(2, 17), Cells(i + 1, 17)))
    Debug.Print "耗费时间: " & Format(Timer - sngStart, "0.0000000000")
    Cells(1, 14) = "管径"
    Cells(1, 15) = "材质"
    Cells(1, 16) = "长度  m"
    Cells(1, 17) = "数量"
    Cells(i + 2, 15) = "合计:"
    End Sub
    

    展开全文
  • VBA基础编程开发课程

    2022-07-03 17:18:22
    爱好:excel 的公式和VBA编程,Access数据库,SQL数据库、VB和VB.NET Excel表格作品:《VBA代码宝》、《VBA进销存系统》、《图书馆系统》、《发票凑数器》、《进销存模板表格》、《出入库系统》等等的模板表格等...
  • vba关于取消自动筛选:

    万次阅读 2020-05-20 21:08:27
    关于取消自动筛选: If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 从蓝桥玄霜版主那看到了,先判断是否做了筛先. ================= 取消自动筛选: Sheets("sheet1").AutoFilterMode = False '注意这里...
  • 上一篇我们已经用VBA实现SQL检索,并实现相同项求和的功能。那么如何根据日期范围筛选我们需要的数据呢?今天我们看看另外一个SQL查询结构: SQL = "select 字段1 from [原始数据$] where 出库时间 between #开始...
  • VBA 根据日期筛选数据

    千次阅读 2022-03-23 15:22:09
    筛选两个日期间的全部数据 Dim a, b, c a = Format(Date, "yyyy/m") '当前年月日 MsgBox a '显示日期时间 '当前月份加4 b = DateAdd("m", 4, a) Debug.Print b Dim Rng As Range, arr As Variant Dim EndRow As...
  • Excel VBA 高级编程-跨表格多条件筛选

    千次阅读 2020-08-24 16:37:14
    大家好,我是陈小虾,是一名自动化方向的IT民工。...本工作表使用VBA实现了如下功能: 1、跨表格多条件筛选 2、在新表格输出结果 3、将结果生成TXT文件 关注公众号:万能的Excel 并回复【跨表格...
  • VBA编程技巧大全

    2013-08-05 09:03:19
    技巧189 保护VBA代码 459 189-1 设置工程密码 459 189-2 设置“工程不可查看” 460 技巧190 优化代码 462 190-1 关闭屏幕刷新 462 190-2 使用工作表函数 464 190-3 使用更快的单元格操作方法 465 190-4 使用With语句...
  • 学会自动化,告别996!最实用VBA办公自动化代码大全详解
  • 求ACCESS VBA数据库编程代码:ACCESS (OFFICE 365家庭版) 在窗体中进入某个字段,出现一个查询向导,我要编写一些代码使查询向导的第二列按照某个值筛选
  • 求ACCESS VBA数据库编程代码:ACCESS (OFFICE 365家庭版) 在窗体中进入某个字段,出现一个查询向导,我要编写一些代码使查询向导的第二列按照某个值筛选
  • 完整的VBA代码宝助手(完全开源)

    千次阅读 2021-08-30 18:23:01
    本工具箱是做的加载宏工作簿,只需要放到启动路径即可随excel启用,可存放VBA代码,其他编程语言,或者您学习的医学知识,会计知识存啥都可以,如只是存储数据,可不看代码,直接使用即可, 把内容放到白色文本框...
  • Excel VBA编程实现自动分页
  • VBA++ 题记:一剪闲云一溪月,一程山水一年华。一世浮生一刹那,一树菩提一烟霞。岁月静好,现世安稳。纵算云水漂泊,心若安宁,亦可淡若清风。希望见者与不见者都能安康。静下心,多学习有用的知识,多提高自己的...
  • vba自动筛选数据透视表 自动更新特定的数据透视表 (Update Specific Pivot Tables Automatically)In Excel 2010, you can use Slicers to change multiple pivot tables. However, you might be working in an ...
  • Excel中VBA编程学习笔记(一)

    千次阅读 2018-11-25 16:45:29
    在Excel VBA中类模块就相当于一个类,类模块的名字就是类名。 下面为定义的一个类Class1,并且有些基本属性及一个初始化函数   【例】 下面定义一个类Class1, Private name, sex As String ...
  • 小白福音——VBA编程常用——命令三百例

    千次阅读 多人点赞 2020-04-20 00:14:59
    # Excel VBA编程常用语句300句 * 本文转自:**http://blog.sina.com.cn/codelee** 博主:**代码农夫** 感谢大佬总结并分享出来~ ************** # * VBA 语句集 * * (第 1 辑) * ************** ***************...
  • 功能: 1、根据输入的关键字,实时搜索数据库筛选 2、不限数据库大小
  • 在之前的文章中我们学习了VBA的基本语法,接下来我们就要学习如何使用VBA开发宏命令脚本,如何与Excel进行交互。 我了解的内容仅限于我自己的使用,可能并不系统,还请谅解。 首先我们可能需要操作Sheet页 1....
  • 大家好,今日内容仍是和大家分享VBA编程中常用的简单“积木”过程代码,第NO.114-NO.115则,内容是:FindPrevious反向查找、利用LIKE查找等内容。VBA过程代码114:利用FindPrevious完成查找Sub mynz()Set rng = ...
  • Excel·VBA指定条件删除整行整列

    千次阅读 2022-03-15 22:14:18
    目录 sub1.删除工作表所有空行 sub2.删除工作表所有空列 sub3....Else Rows(i).Delete '删除行 End If Next End Sub 举例 《excel吧提问-多行多列重复数据筛选》 多列去重前 选中A-D列,运行sub5,获得结果
  • 1、根据每天的出库、入库记录,自动筛选出产品ID号 2、实时统计每个产品的库存状态 3、自动统计每个月产品总出库、入库数量 关注公众号:万能的Excel 并回复【进销表】获取源文件! Private Sub Worksheet_...

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 866
精华内容 346
关键字:

vba编程筛选代码