Excel中使用VBA筛选数据并将结果另存为新的EXCEL文件

最新推荐文章于 2024-08-13 08:39:15 发布

anyqu

最新推荐文章于 2024-08-13 08:39:15 发布

阅读量2.8w

点赞数 2

分类专栏：其它文章标签： excel vba vpn 工具 function windows

本文链接：https://blog.csdn.net/anyqu/article/details/4856918

版权

其它专栏收录该内容

40 篇文章 0 订阅

订阅专栏

今天同学问我如题的问题。简单查了一下网上的代码。实现了要求，特留记一下。

需求：

某EXCEL文件中有两个（其实是多个，但需要用的就两个）如下图：

同学的领导要求，根据选中的名称显示出这个单位的所有手机号码（为保护隐私用*号替换了）及相关信息。说白了就是表（正常集团 (2)）里的数据太多，他想要根据关面列出的名查看其具体包含哪些号等信息。

解决方案：

先将“正常集团（２）表设置筛选。

然后在１０个＊＊的表的ＳＨＥＥＴ选项卡上点击右键－》查看代码，写下如下代码

代码如下：

Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 1 And Target.Count = 1 Then Calc (Target.Text) End If End Sub Function Calc(ByVal SelectName As String) Sheets(3).Select ActiveSheet.Range("$B$1:$B$60448").AutoFilter Field:=1, Criteria1:=SelectName 'Sheets(3).Cells.Select 'Application.CutCopyMode = False 'Selection.Copy 'Sheets.Add After:=Sheets(Sheets.Count) 'Sheets(Sheets.Count).Select 'Cells.Select 'ActiveSheet.Paste 'Sheets(Sheets.Count).Name = SelectName 'Sheets(2).Select 'Range("A2").Select 'Workbooks.Add 'ActiveSheet.Paste 'Application.CutCopyMode = False 'ActiveWorkbook.SaveAs Filename:= _ ' "D:/DHList/" + SelectName + ".xls", FileFormat:= _ ' xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _ ' , CreateBackup:=False 'ActiveWindow.Close ' Windows("政企全网VPN用户23日.xls").Activate ' Sheets(2).Select ' Range("B1").Select End Functi

具体代码什么意思就不用我解释了吧！

由于后来她又改变主意了，不需要另存成文件了，所以另存文件的部分被我注释掉了！需要用的朋友把注释去掉就可以了！另存储路径需要先创建。我当时没有想那么多，而且他也不需要那么复杂就没有包含创建目录以及判断文件是否存在一类的。如果有这方面的需求可以根据情况自己扩展一下就行了！

－－－－－－－－－－－－－－－－

补充：

在写代码时一直想找到多行注释按钮，但一直也没有找到。ＶＢＡ用的也不多，在编辑器中类似／＊　＊／或｛　｝这样的方法行不行。对此耿耿于怀，刚才在网上查找了一下。终于找到答案了，原来自己太大意了。

在工具栏上右键点击－》编辑　会弹出一个工具栏。其中就包括注释及取消注释的按钮。

有人一直说看不到，不知道是看不到代码还是图片。如是代码，请在代码那行上有个加号，点开即可：下边把代码附上！

[code=vb]
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)  
            If Target.Column = 1 And Target.Count = 1 Then  
                    Calc (Target.Text)  
            End If  
    End Sub  
    Function Calc(ByVal SelectName As String)  
        Sheets(3).Select  
        ActiveSheet.Range("$B$1:$B$60448").AutoFilter Field:=1, Criteria1:=SelectName  
        'Sheets(3).Cells.Select  
        'Application.CutCopyMode = False  
        'Selection.Copy  
        'Sheets.Add After:=Sheets(Sheets.Count)  
        'Sheets(Sheets.Count).Select  
        'Cells.Select  
        'ActiveSheet.Paste  
        'Sheets(Sheets.Count).Name = SelectName  
        'Sheets(2).Select  
        'Range("A2").Select  
        'Workbooks.Add  
        'ActiveSheet.Paste  
        'Application.CutCopyMode = False  
        'ActiveWorkbook.SaveAs Filename:= _  
        '    "D:/DHList/" + SelectName + ".xls", FileFormat:= _  
        '    xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _  
        '    , CreateBackup:=False  
        'ActiveWindow.Close  
       ' Windows("政企全网VPN用户23日.xls").Activate  
       ' Sheets(2).Select  
       ' Range("B1").Select  
    End Function  
[/code]