1使用场景-----
-----工作中我们可能会遇到这样的场景：需要按照一个特定的规则清单，将某些文件从一个文件夹筛选出来比如说：从1000份体检报告中，筛选出单位A的文件这时候我们拿着单位A的名单一个个复制出来，可能要到猴年马月了。
举例说明庆余年剧组的部分人员参加了年度体检，体检报告与其他剧组的共同存放在test1这个文件夹中。现在需要从test1文件夹中找出庆余年剧组中参加了体检的人员的报告。
2方法概述将test1文件夹中的文件形成一份列表列表与庆余年剧组人员名单进行比对根据最终清单使用VBA代码移动文件3生成文件列表标记文件夹路径：E:\测试\test1点击系统的开始菜单=>运行（win+r）=>cmd
将CMD中的路径切换为当前文件夹路径（英文输入法）首先切换为主系统盘，英文标点：键入【E:】然后回车然后切换为当前文件夹：键入【CD】+【空格】+【测试\test1】
键入【dir/b>E:\文件名单.xls】按下回车。文件路径可根据个人意愿改动。
4处理文件名单单元格分列：将文件名称进行批量处理执行分列操作后，从文件名中提取待比对的信息关闭观看更多更多退出全屏视频加载失败，请刷新页面再试
刷新
视频详情
使用Excel条件格式对名单进行比对开始=>条件格式=>突出显示单元格规则=>重复值关闭观看更多更多退出全屏视频加载失败，请刷新页面再试
刷新
视频详情 处理最终名单并与源文件名称拟合名单格式与报告文件名称格式需要一致，因此需要将excel名单进行处理
使用Excel的CONCATENATE函数进行名单处理
5使用VBA代码自动筛选移动/复制文件关闭观看更多更多退出全屏视频加载失败，请刷新页面再试
刷新
视频详情 打开最终名单Excel中表格，打开Microsoft Visual Basic for Applications窗口按住ALT+F11或点击【开发工具=>Visual Basic】
点击插入=>模块，并将以下VBA代码粘贴到模块窗口中Submovefiles()UpdatebyExtendofficeDimxRg As Range, xCell As RangeDimxSFileDlg As FileDialog, xDFileDlg As FileDialog。
DimxSPathStr As Variant, xDPathStr As VariantDimxVal As StringOnError Resume NextSetxRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
IfxRg Is Nothing Then Exit SubSetxSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)xSFileDlg.Title
= " Please select the original folder:"IfxSFileDlg.Show <> -1 Then Exit SubxSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
SetxDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)xDFileDlg.Title = " Please select the destination folder:"
IfxDFileDlg.Show <> -1 Then Exit SubxDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"ForEach xCell In xRg
xVal = xCell.ValueIfTypeName(xVal) = "String" And xVal <> "" ThenFileCopyxSPathStr & xVal, xDPathStr & xVal
KillxSPathStr & xValEndIfNextEndSub然后点击运行或F5键，弹出一个提示框提醒你选择包含文件名的单元格
然后点击OK按钮，在弹出的窗口中，选择从哪个文件夹中移出文件
然后点击OK，选择要移动到哪个文件夹
最后点击OK关闭窗口，现在，文件已经被移动到指定的另一个文件夹中，并且该文件夹是基于工作表列表中的文件名。
备注：如果只是想将文件复制到另一个文件夹，但保留原始文件，请使用下面的VBA代码：Subcopyfiles()UpdatebyExtendofficeDimxRg As Range, xCell As Range
DimxSFileDlg As FileDialog, xDFileDlg As FileDialogDimxSPathStr As Variant, xDPathStr As VariantDimxVal As String
OnError Resume NextSetxRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
IfxRg Is Nothing Then Exit SubSetxSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)xSFileDlg.Title
= "Please select the original folder:"IfxSFileDlg.Show <> -1 Then Exit SubxSPathStr = xSFileDlg.SelectedItems.Item(1) & "\"
SetxDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)xDFileDlg.Title = "Please select the destination folder:"
IfxDFileDlg.Show <> -1 Then Exit SubxDPathStr = xDFileDlg.SelectedItems.Item(1) & "\"ForEach xCell In xRg
xVal = xCell.ValueIfTypeName(xVal) = "String" And xVal <> "" ThenFileCopyxSPathStr & xVal, xDPathStr & xVal
EndIfNextEndSub【总结】这算是一篇比较硬核的教程文章了，但是实现起来还是比较容易的，小编也为大家录制了相关的动图，相信大家应该是可以看懂的动图超过300k了，不让上传，所以转成视频了最后欢迎大家关注公众号和博客，文中文末的广告帮忙点一下，秋梨膏！！！。
文章原文会同步更新与松鼠blog上，戳“阅读原文”我们一起进步。
发表评论:
◎欢迎参与讨论，请在这里发表您的看法、交流您的观点。