Excel精英培训网

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

[已解决]求姐:VBA只要打开文件夹下不同的命名的其中一个

[复制链接]
发表于 2017-6-16 20:46 | 显示全部楼层 |阅读模式
本帖最后由 qg5041 于 2017-6-17 16:30 编辑

如图,只求打开,分别是1 、23、以jihua*.csv、计划报告*.csv统计报告*.csv、只求打开其中的一种,怎么更改呢?求大师帮助。 QQ图片20170616204001.png

Private Sub CommandButton1_Click()
Dim MyPath, MyName, AWbName
Dim Wb As Workbook, WbN As String
Dim G As Long
Dim Num As Long
Dim BOX As String
Application.ScreenUpdating = False
MyPath = ActiveWorkbook.Path
MyName = Dir(MyPath & "\" & "*.csv")
AWbName = ActiveWorkbook.Name
Num = 0
Do While MyName <> ""
If MyName <> AWbName Then
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
Num = Num + 1
With ThisWorkbook.ActiveSheet
.Cells(.Range("A65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
For G = 1 To Wb.Sheets.Count
Wb.Sheets(G).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
Next
WbN = WbN & Chr(13) & Wb.Name
Wb.Close False
End With
End If
MyName = Dir
Loop
Range("A1").Select
Application.ScreenUpdating = True

最佳答案
2017-6-17 16:35
  1. Private Sub CommandButton1_Click()
  2. Dim MyPath, MyName, AWbName
  3. Dim Wb As Workbook, WbN As String
  4. Dim G As Long
  5. Dim Num As Long
  6. Dim BOX As String
  7. Application.ScreenUpdating = False
  8. MyPath = ActiveWorkbook.Path
  9. MyName = Dir(MyPath & "" & "*.csv")
  10. AWbName = ActiveWorkbook.Name
  11. Num = 0
  12. Do While MyName <> ""
  13.     If MyName <> AWbName And (MyName Like "jihua*" Or MyName Like "计划报告*" Or MyName Like "统计报告*") Then
  14.         Set Wb = Workbooks.Open(MyPath & "" & MyName)
  15.         Num = Num + 1
  16.         With ThisWorkbook.ActiveSheet
  17.             .Cells(.Range("A65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
  18.             For G = 1 To Wb.Sheets.Count
  19.                 Wb.Sheets(G).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
  20.             Next
  21.             WbN = WbN & Chr(13) & Wb.Name
  22.             Wb.Close False
  23.         End With
  24.     End If
  25.     MyName = Dir
  26. Loop
  27. Range("A1").Select
  28. Application.ScreenUpdating = True
复制代码
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2017-6-16 20:48 | 显示全部楼层
回复

使用道具 举报

 楼主| 发表于 2017-6-17 16:07 | 显示全部楼层
chart888 发表于 2017-6-16 20:48
什么叫只求打开一种?

就是打开一种,以什么开头的excel,别的excel不用打开
回复

使用道具 举报

发表于 2017-6-17 16:13 | 显示全部楼层
qg5041 发表于 2017-6-17 16:07
就是打开一种,以什么开头的excel,别的excel不用打开

需要打开的excel名称有什么规律或者固定字符吗
回复

使用道具 举报

 楼主| 发表于 2017-6-17 16:29 | 显示全部楼层
chart888 发表于 2017-6-17 16:13
需要打开的excel名称有什么规律或者固定字符吗

有呀,上面写着,区分  1   2  3 excel表格都带有开头的那些

回复

使用道具 举报

发表于 2017-6-17 16:35 | 显示全部楼层    本楼为最佳答案   
  1. Private Sub CommandButton1_Click()
  2. Dim MyPath, MyName, AWbName
  3. Dim Wb As Workbook, WbN As String
  4. Dim G As Long
  5. Dim Num As Long
  6. Dim BOX As String
  7. Application.ScreenUpdating = False
  8. MyPath = ActiveWorkbook.Path
  9. MyName = Dir(MyPath & "" & "*.csv")
  10. AWbName = ActiveWorkbook.Name
  11. Num = 0
  12. Do While MyName <> ""
  13.     If MyName <> AWbName And (MyName Like "jihua*" Or MyName Like "计划报告*" Or MyName Like "统计报告*") Then
  14.         Set Wb = Workbooks.Open(MyPath & "" & MyName)
  15.         Num = Num + 1
  16.         With ThisWorkbook.ActiveSheet
  17.             .Cells(.Range("A65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
  18.             For G = 1 To Wb.Sheets.Count
  19.                 Wb.Sheets(G).UsedRange.Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1)
  20.             Next
  21.             WbN = WbN & Chr(13) & Wb.Name
  22.             Wb.Close False
  23.         End With
  24.     End If
  25.     MyName = Dir
  26. Loop
  27. Range("A1").Select
  28. Application.ScreenUpdating = True
复制代码
回复

使用道具 举报

 楼主| 发表于 2017-6-17 16:50 | 显示全部楼层

谢谢大神,我试试
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 07:51 , Processed in 0.414578 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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