精华内容
下载资源
问答
  • 通过VBA程序批量修改文件夹名称,需要列出旧文件夹、新文件夹
  • 1、如果你有现成的一个工作簿含有多个工作表的文件,想分成多个工作簿的话, 可以通过office2007或office2013等打开execl,然后通过execl里面的开发工具, 输入以下运行代码,执行就行(拆分的工作簿在你设置的路径...

    前提:电脑上装有office2007或office2013等,WPS不行。

    1、如果你有现成的一个工作簿含有多个工作表的文件,想分成多个工作簿的话,
    可以通过office2007或office2013等打开execl,然后通过execl里面的开发工具,
    输入以下运行代码,执行就行(拆分的工作簿在你设置的路径下):

    Sub cfb()
    Dim m As Integer
    Dim sht, sht1 As Worksheet
    '按照需要将分出来的表分成多个工作簿
    n = InputBox(“请输入excel的路径”)
    For Each sht1 In Sheets
    sht1.Copy
    ActiveWorkbook.SaveAs Filename:=n & “” & sht1.Name & “.xlsx”
    ActiveWorkbook.Close
    Next
    End Sub

    2、如果你的工作簿里只有一个工作表,但是需要根据工作表中的某个字段拆分成多个工作簿,并且以该字段值命名工作簿的话,输入以下运行代码,执行就行(拆分的工作簿在你设置的路径下):

    Sub cfb()
    Dim i, j, k, l, m As Integer
    Dim sht, sht1 As Worksheet
    m = InputBox(“想按照第几列分表!”)
    '分表前先删除多余表(将需要的工作表放最前方就行)
    Application.DisplayAlerts = False
    If Sheets.Count > 1 Then
    For i = Sheets.Count To 2 Step -1
    Sheets(i).Delete
    Next
    End If
    '通过字段名进行建表,注意需要建表的字段不能违反表名规则
    j = Sheet1.Range(“a65536”).End(xlUp).Row
    For i = 2 To j
    k = 0
    For Each sht In Sheets
    If sht.Name = Sheet1.Cells(i, m) Then
    k = 1
    End If
    Next
    If k = 0 Then
    Sheets.Add after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = Sheet1.Cells(i, m)
    End If
    Next
    '通过已知到的表名进行数据筛选赋值拷贝数据
    For l = 2 To Sheets.Count
    Sheet1.Range(“a1:iv65536”).AutoFilter Field:=m, Criteria1:=Sheets(l).Name
    Sheet1.Range(“a1:iv65536”).Copy Sheets(l).Range(“a1”)
    Next
    Sheet1.Range(“a1:iv65536”).AutoFilter
    '按照需要将分出来的表分成多个工作簿
    m = InputBox(“是否需要分成多个工作簿:1.是,2.否”)
    If m = 1 Then
    n = InputBox(“请输入excel的路径”)
    For Each sht1 In Sheets
    sht1.Copy
    ActiveWorkbook.SaveAs Filename:=n & “” & sht1.Name & “.xlsx”
    ActiveWorkbook.Close
    Next
    End If
    End Sub

    3、如果你有现成的一个工作簿含有多个工作表的文件,想分成多个工作簿,并且有隐藏工作表时,弹出输入框,选择是否执行或显示当前隐藏的工作表。输入以下运行代码,执行就行(拆分的工作簿在当前目录的"拆分"文件夹中):

    Sub cfb()
    Application.ScreenUpdating = False
    Dim xpath, isNext As String
    Dim sht As Worksheet
    xpath = Application.ActiveWorkbook.Path & “\拆分”
    '如果文件夹不存在,则新建文件夹
    If Len(Dir(xpath, vbDirectory)) = 0 Then MkDir xpath
    For Each sht In Worksheets
    If sht.Visible = False Then
    'MsgBox “有隐藏工作表” & sht.Name
    '隐藏工作表是否拆分
    isNext = InputBox(“1:跳过不处理” & Chr(10) & “2:处理” & Chr(10) & “空:默认不处理”, “【” & sht.Name & “】为隐藏工作表,请选择执行方式”)
    If isNext = “2” Then
    sht.Visible = True '取消工作表的隐藏
    sht.Copy
    ActiveWorkbook.SaveAs Filename:=xpath & “” & sht.Name & “.xlsx”
    ActiveWorkbook.Close
    sht.Visible = False '恢复工作表的隐藏
    End If
    ElseIf sht.Visible = True Then
    sht.Copy
    ActiveWorkbook.SaveAs Filename:=xpath & “” & sht.Name & “.xlsx”
    ActiveWorkbook.Close
    End If
    Next
    'MsgBox “工作簿拆分完成”
    Application.ScreenUpdating = True '恢复屏幕更新
    End Sub

    以上就是大致的拆分情况。

    展开全文
  • 要求:将文件夹1-1.xlsx、文件夹1-1.xlsx移动到文件夹1,依次类推代码及说明:Sub 移动文件()Dim MyFold As Object, MyFile As ObjectDim ipath As String, TargetFolder As String'获取当前文件夹的路径ipath = ...
    a6c26ab3a900064362ec95181d3058a0.png

    要求:将文件夹1-1.xlsx、文件夹1-1.xlsx移动到文件夹1,依次类推

    代码及说明:

    Sub 移动文件()

    Dim MyFold As Object, MyFile As Object

    Dim ipath As String, TargetFolder As String

    '获取当前文件夹的路径

    ipath = ThisWorkbook.Path &""

    '建立文件系统对象变量MyFold

    Set MyFold =CreateObject("Scripting.FileSystemObject")

    '循环当前路径文件夹下的所有文件

    For Each MyFile InMyFold.GetFolder(ipath).Files

    '如果文件是.xlsx文件,则

    If MyFile.Name Like "*.xlsx"Then

    '获取该文件应属文件夹名称,需根据实际的工作表名称修改此句代码,Split()函数返回一个数组,其中包含基于分隔符分割的特定数量的值

    TargetFolder = ipath & "" & Split(MyFile.Name, "-")(0)

    '文件夹是否存在则新建一个文件夹

    If NotMyFold.FolderExists(TargetFolder) Then

    MyFold.CreateFolderTargetFolder

    End If

    '文件夹中已经存在该文件则删除它

    If MyFold.FileExists(TargetFolder& "" & MyFile.Name) Then

    MyFold.DeleteFile TargetFolder& "" & MyFile.Name

    End If

    '将文件移动到所属文件夹

    MyFile.Move (TargetFolder &"")

    End If

    Next

    Set MyFold = Nothing

    End Sub

    展开全文
  • 我们可能会经常要将一个文件夹中的所有文件都遍历一遍,然后进行修改,下面就介绍用Dir函数实现遍历*.xlsx文件的方法 Dir 函数 返回一个 String,用以表示一个文件名、目录名或文件夹名称,它必须与指定的...

    我们可能会经常要将一个文件夹中的所有文件都遍历一遍,然后进行修改,下面就介绍用Dir函数实现遍历*.xlsx文件的方法

    Dir 函数

    返回一个 String,用以表示一个文件名、目录名或文件夹名称,它必须与指定的模式或文件属性、或磁盘卷标相匹配。

    语法

    Dir[(pathname[, attributes])]

    第一个参数即是文件的地址,第一次引用的时候要标注,第二次用的时候就不必指出了,下面举个例子,遍历下面文件夹中的Excel2010文件,然后输出文件的名字~

     批量遍历某类文件(*.xlsx) 

    [vb]  view plain  copy
    1. Sub OpenAndClose()  
    2.     Dim MyFile As String  
    3.     Dim s As String  
    4.     Dim count As Integer  
    5.     MyFile = Dir("C:\Users\McDelfino\Desktop\2.JPL_SCAT_EXCEL全\" & "*.xlsx")  
    6.     '读入文件夹中的第一个.xlsx文件  
    7.     count = count + 1       '记录文件的个数  
    8.     s = s & count & "、" & MyFile  
    9.     Do While MyFile <> ""  
    10.         MyFile = Dir        '第二次读入的时候不用写参数  
    11.         If MyFile = "" Then  
    12.             Exit Do         '当MyFile为空的时候就说明已经遍历完了,这时退出Do,否则还要运行一遍  
    13.         End If  
    14.         count = count + 1  
    15.         If count Mod 2 <> 1 Then  
    16.             s = s & vbTab & count & "、" & MyFile  
    17.         Else  
    18.             s = s & vbCrLf & count & "、" & MyFile  
    19.         End If  
    20.     Loop  
    21.     Debug.Print s  
    22. End Sub  

    运行结果如下:

    53、

    遍历每个文件,并且修改文件,先将文件的名字存在数组中,然后通过数组遍历打开每个文件,修改,再关闭文件~

    [vb]  view plain  copy
    1. Sub OpenCloseArray()  
    2.     Dim MyFile As String  
    3.     Dim Arr(100) As String  
    4.     Dim count As Integer  
    5.     MyFile = Dir("C:\Users\McDelfino\Desktop\2.JPL_SCAT_EXCEL全\" & "*.xlsx")  
    6.     count = count + 1  
    7.     Arr(count) = MyFile  
    8.       
    9.     Do While MyFile <> ""  
    10.         MyFile = Dir  
    11.         If MyFile = "" Then  
    12.             Exit Do  
    13.         End If  
    14.         count = count + 1  
    15.         Arr(count) = MyFile         '将文件的名字存在数组中  
    16.     Loop  
    17.       
    18.     For i = 1 To count  
    19.         Workbooks.Open Filename:="C:\Users\McDelfino\Desktop\2.JPL_SCAT_EXCEL全\" & Arr(i)  '循环打开Excel文件  
    20.             Cells(1, 1) = "alex_bn_lee"             '修改打开文件的内容  
    21.         ActiveWorkbook.Close savechanges = True     '关闭打开的文件  
    22.     Next  
    23. End Sub  

    要是想要修改每个工作簿的内容可以这样遍历一下,显示将文件夹中的工作簿的名字存到一个字符串数组中,然后在用For...Next语句遍历

     批量遍历某个文件夹中的所有文件(*.*) 

    注意:遍历的时候,顺序完全是按照文件名的顺序排的,而不是按照文件夹中文件的顺序~

    [vb]  view plain  copy
    1. Sub dlkfjdl()  
    2.     Dim MyFile As String  
    3.     Dim count As Integer  
    4.     count = 1  
    5.     MyFile = Dir("C:\Users\McDelfino\Desktop\桌面\Excel\*.*")  
    6.     Debug.Print "1、" & MyFile  
    7.     Do While MyFile <> ""  
    8.         count = count + 1  
    9.         MyFile = Dir  
    10.         If MyFile = "" Then Exit Do  
    11.         Debug.Print count & "、" & MyFile  
    12.     Loop  
    13. End Sub  

     批量建立TXT文件  

    批量建立,同时可以批量赋值到文本文件中~

    [vb]  view plain  copy
    1. Sub kdjfl()  
    2.     For i = 1 To 10  
    3.         Open "C:\Users\McDelfino\Desktop\练习\" & Format(i, "00") & ".txt" For Output As #i  
    4.         Print #i, i  
    5.         Close #i  
    6.     Next  
    7. End Sub  

     GetFolder方法

    返回一个和指定路径中文件夹相对应的 Folder 对象。应用于FileSystemObject对象~

     遍历文件夹内的所有文件 

    [vb]  view plain  copy
    1. Sub GetFiles()  
    2.     Dim fs, f, f1, fc  
    3.     Set fs = CreateObject("scripting.filesystemobject")  
    4.     Set f = fs.getfolder("F:\Desktop\2.wind_numerical_excello")  
    5.     Set fc = f.Files  
    6.   
    7.     For Each f1 In fc  
    8.         Debug.Print f1  
    9.         Debug.Print "f1 = " & TypeName(f1)  
    10.     Next  
    11.       
    12.     MsgBox "fs = " & TypeName(fs) _  
    13.     & vbCrLf & "f = " & TypeName(f) _  
    14.     & vbCrLf & "fc = " & TypeName(fc)  
    15.       
    16. End Sub  

    fs = FileSystemObject对象:提供对计算机文件系统的访问。

    f = Folder对象:提供对一个文件夹所有属性的访问。

    fc = Files集合:在一个文件夹内的所有 File 对象的集合。

    f1 = File对象:提供对文件所有属性的访问。

     FileSystemObject对象及TextStream对象的方法举例:

    [vb]  view plain  copy
    1. Sub djkflds()  
    2.     Dim fso, fd, fs, f, ft, s  
    3.     Set fso = CreateObject("Scripting.FileSystemObject")  
    4.       
    5.     fso.MoveFile "F:\Desktop\1.xlsx""F:\Desktop\2.wind_numerical_excello\1.xlsx"  
    6.     '移动文件  
    7.        
    8.     fso.MoveFolder "F:\Desktop\temp""F:\Desktop\2.wind_numerical_excello\temp"  
    9.     '移动文件夹  
    10.       
    11.     MsgBox fso.FileExists("F:\Desktop\1.xlsx")  
    12.     '判断文件是否存在,存在返回True,否则返回False  
    13.       
    14.     MsgBox fso.FolderExists("F:\Desktop\temp")  
    15.     '判断文件夹是否存在,存在返回True,否则返回False  
    16.      
    17.     Set ft = fso.OpenTextFile("F:\Desktop\1.txt", 8, -2)  
    18.     '8打开一个文件并写到文件的尾部 -2使用系统缺省打开文件  
    19.     'ft是TextStream对象,加快对文件的顺序访问  
    20.     ft.Write "Hello World"      'Write方法,在一行上  
    21.     For i = 1 To 10  
    22.         ft.WriteLine i          'WriteLien方法,另起一行  
    23.     Next  
    24.     ft.Close                    'Close方法,关闭文件  
    25.       
    26.     fso.DeleteFolder "F:\Desktop\1"  
    27.     '删除一个文件夹,并且是不放在回收站里面的  
    28.   
    29. End Sub  


      Folder对象的属性和方法举例:


     Size方法

    [vb]  view plain  copy
    1. Sub GetSize()  
    2.     Dim fso, fd, fs, f  
    3.     Set fso = CreateObject("Scripting.FileSystemObject")  
    4.     Set fd = fso.GetFolder("F:\Desktop\2.wind_numerical_excello")  
    5.     Set fs = fd.SubFolders  
    6.     For Each f In fs  
    7.         Debug.Print f.Name, Format(f.Size / 1024 / 1024, "#.##") & "M"  
    8.     Next  
    9. End Sub  


      File对象的属性和方法举例:

    属性和方法与Folder对象类似~


    遍历文件夹中的子文件夹及文件

    [vb]  view plain  copy
    1. Sub getfiles()  
    2.     Dim fso, folder, fds, fd, folder2, fs, f  
    3.     Set fso = CreateObject("Scripting.FileSystemObject")  
    4.     Set folder1 = fso.GetFolder("F:\Desktop\2.wind_numerical_excello")  '获得文件夹  
    5.     Set fds = folder1.subfolders        '子文件夹集合  
    6.     For Each fd In fds                  '遍历子文件夹  
    7.         Debug.Print fd.Name  
    8.         Set folder2 = fd                '获得文件夹2  
    9.         Set fs = folder2.Files          '文件集合  
    10.         For Each f In fs                '遍历文件  
    11.             Debug.Print f.Name  
    12.         Next  
    13.         Debug.Print  
    14.     Next  
    15. End Sub  

    展开全文
  • 大家好,今日内容仍是和大家分享VBA编程常用的简单“积木”过程代码,这些内容大多是取至我编写的“VBA代码解决方案”教程内容。NO.174-NO.175内容是:NO. 174:如何利用VBA代码,判断是否为空表,如果为空表则...

    339927b915a82dab55329fb18b98bc81.png

    分享成果,随喜真能量。大家好,今日内容仍是和大家分享VBA编程中常用的简单“积木”过程代码,这些内容大多是取至我编写的“VBA代码解决方案”教程中内容。NO.174-NO.175内容是:

    NO. 174:如何利用VBA代码,判断是否为空表,如果为空表则使用Delete方法删除

    NO. 175:利用VBA的自定义函数,判断工作表是否存在

    8f94838006c3798d97257f2cd0ae6937.png

    VBA过程代码174:如何利用VBA代码,判断是否为空表,如果为空表则使用Delete方法删除

    Sub mynz()

    Dim Sh As Worksheet

    Application.DisplayAlerts = False

    i = 1

    For Each Sh In ThisWorkbook.Sheets

    If MyIsBlankSht(Sh) Then Sh.Delete: MsgBox "删除" & i & "个工作表了": i = i + 1

    Next

    Application.DisplayAlerts = True

    MsgBox "共删除" & i - 1 & "个工作表!"

    End Sub

    代码的解析说明:Mynz过程使用自定义的MyIsBlankSht函数删除工作簿中所有空工作表。

    代码将Application对象的DisplayAlerts属性设置为False,使删除时不显示系统警告对话框。

    使用For Each...Next语句遍历所有工作表,使用自定义的MyIsBlankSht函数判断是否为空表,如果为空表则使用Delete方法删除。

    dceb59c531e789463db1c776524e0ff9.png

    VBA过程代码175:利用VBA的自定义函数,判断工作表是否存在

    Function MyExistSh(Sh As String) As Boolean

    Dim Sht As Object

    On Error Resume Next

    Set Sht = Sheets(Sh)

    If Err.Number = 0 Then MyExistSh = True

    Set Sht = Nothing

    End Function

    代码的解析说明:自定义MyExistSh函数包含一个String类型的参数,代表需要判断的工作表名称。如果该工作表存在,则返回True。代码判断前面的代码是否出错,如果前面的代码存在错误,则表示不存在指定名称的表。

    0d6540864197e7784b919e3240e70a41.png

    VBA是实现自己小型办公自动化的有效手段,我根据自己20多年的VBA实际利用经验,现推出了四部VBA教程,这些是我多年编程经验的记录,也是我“积木编程”思想的体现。每一讲都是较大块的“积木”,可以独立的完成某些或者某类的过程,有需要的朋友可以联络(WeChat:NZ9668)分享。利用这些可以提高自己的编程效率。其一:“VBA代码解决方案”PDF教程,是VBA中各个知识点的讲解,覆盖了绝大多数的知识点,是初学及中级以下人员必备;其二“VBA数据库解决方案”PDF教程,数据库是数据处理的利器,对于中级人员应该掌握这个内容了。其三“VBA数组与字典解决方案”PDF教程,讲解VBA的精华----字典,是我们打开思路,提高代码水平的必备。其四“VBA代码解决方案”视频教程。目前正在录制,“每天20分钟,半年精进VBA”,越早参与,回馈越多。现在录制到第三册的99讲。

    展开全文
  • 很多小伙伴表示没学会,那么我们今天不需要VBA代码,只需要几步操作就可以完成,第1,2,3,4个工作簿里面的数据如下所示:其中第1个工作簿有两个工作表,第2个工作表的内容是:第2个工作簿第第3个工作簿第4个工作...
  • Workbooks工作簿对象 For Each 循环 第一块内容:For Each循环 Sub test1() Dim ge As Range'把变量ge定义为Range(rng)类型,单元格变量/区域变量 For Each ge In Range("A1:A10")'在单元格区域A1:A10范围内,...
  • '获取需要合并的工作簿的序号,放入数组 Count = 0 For i = 1 To Sheets.Count If InStr(Sheets(i).Name, "说明") (Sheets(i).Name, "动态销售定价表") > 0 Then Count = Count + 1 End If Next If ...
  • Excel VBA破解工作表/工作簿保护密码

    千次阅读 2010-09-08 16:31:00
    平时在用Excel编辑文件时,如果不希望别人修改文件的内容,我们一般会为工作表或工作簿添加上密码,起到保护作用。  而当我们从网上下载了一个Excel文档,如果里面带有工作表/工作簿密码保护,我们又急需修改这个...
  • 我们可能会经常要将一个文件夹中的所有文件都遍历一遍,然后进行修改,下面就介绍用Dir函数实现遍历*.xlsx文件的方法 Dir 函数 返回一个 String,用以表示一个文件名、目录名或文件夹名称,它必须与指定的模式或...
  • Sub 遍历一个文件夹里的excel文件() Rem 用bat 怎么写? 'cd C:\VBA 'dir >1.txt '但是这样并没有把文件名给单独列出来? Rem 用python 怎么写? Dim a As Object Dim path path = ...
  • 文件夹导航图 (代码运行背景) Option Compare Database '------------------------------------------------------------------------------------------- ' 1、目的:批量导入表 ' 2、背景: ' 根路径:D:\...
  • 汇总指定文件夹内所有工作簿,自动删除空行
  • 希望了解VBA中的EXCEL的页数,类似于某个单元格的属性,例如:ROW代表行,COLUNN代表列。如果了解EXCEL的页数,那么就可以通过ADD和SHEET两个函数做页增加,通过DELETE和SHEET两个函数做页删除
  • 删除文本 引用文本 H 2 O is是液体。 2 10 运算结果是 1024. 插入链接与图片 链接: link . 图片: 带尺寸的图片: 居中的图片: 居中并且带尺寸的图片: 当然,我们为了让用户更加便捷,...
  • 本节将重点讲述如何新建、打开、删除、复制、移动和重命名文件和文件夹操作等。  对于文件和文件夹操作,我们一般通过下面方法:  。VB命令  。EXCEL对象  。引用其他动态库对象  。API函数  在...
  • 1.EXCEL VBA遍布文件夹的操作 关于VBA遍历文件夹主要用的是提供的Application.FileDialo函数来由个人进行自由选择,通过获取选择的文件夹地址之后,通过Dir函数来匹配选取文件夹下的相应的文档。相应的VBA程序代码...
  • Excel的个人宏工作簿Personal.xls(b)

    万次阅读 2010-09-01 10:10:00
    用这个Excel文件可以保存经常使用的数据或者宏,例如可以将经常使用自定义函数或宏命令保存到个人宏工作簿中,这样每次打开Excel后就可以直接使用这些宏命令。  二、如何创建个人宏工作簿  可
  • [VBA]Ch03 工作簿(Workbook)基本操作应用示例(一)fanjy 发表于 2006-10-23 13:41:00 第三章 工作簿(Workbook)基本操作应用示例(一)分类:ExcelVBA>>ExcelVBA编程入门范例Workbook对象代表工作簿,而Workbooks集合则...
  • excel合并工作簿VBA

    2012-07-24 14:15:12
    Sub 合并工作簿() Dim p As Integer Dim s As Integer Dim i As Integer Dim hao As String Dim fd As FileDialog Dim strPath As String Application.DisplayAlerts = False '关闭提示窗口 Set newshe = ThisWo.....
  • 1、获取工作薄数量 Private Sub test()  MsgBox ("工作薄数量为:" &amp; Workbooks.Count)  Workbooks(1).Activate  Workbooks("第6次作业成绩.xls").Activate MsgBox ("当前...
  • 同一文件夹下的多个excel文件的同一位置的批量修改工具 vbs語言 Option Explicit Dim bk, ex, f, gf, sh, so, sheet Set so = CreateObject("Scripting.FileSystemObject") Set gf = so.GetFolder(".") Set ex = ...
  • 话说前两天有朋友在后台发消息问,能不能分享一期代码,将指定文件夹下,包含某个关键词的工作簿中的工作表,批量移动到当前工作簿?今天我们就分享解决此类问题的小代码。开门见山,代码如下:Sub CltSheets() '...
  • 今天从网上学到如何破解vba工程密码以及工作表保护密码,在这里分享一下。 破解vba工程密码:(引用自http://jingyan.baidu.com/article/2009576170cc05cb0721b437.html) 1.将你要破解的Excel文件关闭,切记一定要...
  • 今天从网上学到如何破解vba工程密码以及工作表保护密码,在这里分享一下。 破解vba工程密码:(引用自http://jingyan.baidu.com/article/2009576170cc05cb0721b437.html)1.将你要破解的Excel文件关闭,切记一定要...
  • 一个工作簿中含有多个工作表现在要将格式相同的所有表格合并在一张表格中,如果采用最原始的复制粘贴是多么恐怖的一件事。模拟的数据只是几个工作簿,而实际工作可能有几十个,光复制粘贴,手都废了。而对于高手,...
  • 之前牛账网小编也给大家分享过很多关于多表合并,读者就提出疑问...一个工作簿中含有多个工作表现在要将格式相同的所有表格合并在一张表格中,如果采用最原始的复制粘贴是多么恐怖的一件事。模拟的数据只是几个工作...
  • 删除活动工作表里所有的JPG图片,(不一定是本工作簿中的工作表); 1.打开本Excel文件,不要关闭; 2.再另外打开你自己需要操作的另一个Excel文件,并保持你要操作的工作表做为当前活动工作表; 3.在你的文件中按...

空空如也

空空如也

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

vba删除文件夹中的工作簿