Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2695|回复: 3

[已解决]怎样实现提取将文件名指定字段

[复制链接]
发表于 2016-6-14 11:53 | 显示全部楼层 |阅读模式
本帖最后由 乐乐2006201506 于 2016-6-14 12:17 编辑

        希望在下面代码中加入批注中的公式,或者实现此公式的功能,并直接将结果(姓名)输入到B1及后边的单元格中。
        我改变红色部分,但是运行不成功,谢谢!
提取文件名 含公式.png
Sub 提取指定文件夹内的所有文件名() '含所有子文件夹内的文件
    Dim Fso As Object, arrf$(), mf&
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Call GetFiles1(CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件夹", 0, "").Self.Path, Fso, arrf, mf)
    [b1].Resize(mf) = Application.Transpose(arrf)
    Set Fso = Nothing
End Sub

Private Sub GetFiles1(ByVal sPath$, ByRef Fso As Object, ByRef arrf$(), ByRef mf&)
    Dim Folder As Object
    Dim SubFolder As Object
    Dim File As Object
    Set Folder = Fso.GetFolder(sPath)

    For Each File In Folder.Files
        mf = mf + 1
        ReDim Preserve arrf(1 To mf)
        arrf(mf) = File.Name
    Next
    For Each SubFolder In Folder.SubFolders
        Call GetFiles(SubFolder.Path, Fso, arrf, mf)
    Next
    Set Folder = Nothing
    Set File = Nothing
End Sub

最佳答案
2016-6-14 13:14
  1. Sub 提取指定文件夹内的所有文件名() '含所有子文件夹内的文件
  2.     Dim Fso As Object, arrf$(), mf&
  3.     Set Fso = CreateObject("Scripting.FileSystemObject")
  4.     Call GetFiles1(CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件夹", 0, "").Self.Path, Fso, arrf, mf)
  5.     [B1].Resize(mf) = Application.Transpose(arrf)
  6.     Set Fso = Nothing
  7.     For i = 1 To UBound(arrf)
  8.         Cells(i, 3) = "=Mid(B" & i & ", (Find(""("", B" & i & ") + 1), Find("")"", B" & i & ") - (Find(""("", B" & i & ") + 1))"
  9.     Next
  10. End Sub
复制代码

提取指定文件夹中文件名1.rar

13.64 KB, 下载次数: 12

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2016-6-14 13:14 | 显示全部楼层    本楼为最佳答案   
  1. Sub 提取指定文件夹内的所有文件名() '含所有子文件夹内的文件
  2.     Dim Fso As Object, arrf$(), mf&
  3.     Set Fso = CreateObject("Scripting.FileSystemObject")
  4.     Call GetFiles1(CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件夹", 0, "").Self.Path, Fso, arrf, mf)
  5.     [B1].Resize(mf) = Application.Transpose(arrf)
  6.     Set Fso = Nothing
  7.     For i = 1 To UBound(arrf)
  8.         Cells(i, 3) = "=Mid(B" & i & ", (Find(""("", B" & i & ") + 1), Find("")"", B" & i & ") - (Find(""("", B" & i & ") + 1))"
  9.     Next
  10. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2016-6-14 13:41 | 显示全部楼层
本帖最后由 乐乐2006201506 于 2016-6-14 13:44 编辑

请问:
1.怎样不通过b列数据辅助,直接在b列得到想要的结果;
2.怎样才能选择提取指定文件(如:.xls或.xlsx等)的文件名。
谢谢!
回复

使用道具 举报

发表于 2016-6-14 15:16 | 显示全部楼层
  1. Function tn(target As Range)
  2.   Dim regx As Object
  3.   Dim str As String
  4.   Dim mat, s
  5.   Set regx = CreateObject("vbscript.regexp")
  6.   str = CStr(target.Value)
  7.   With regx
  8.       .Global = True
  9.       .Pattern = "(\W+(?=))"
  10.       Set mat = .Execute(str)
  11.       For Each s In mat
  12.          tn = Replace(s, "(", "")
  13.       Next
  14.   End With
  15. End Function
复制代码
提取名字.gif
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 22:35 , Processed in 0.497216 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表