批量删除文件夹内excel指定的列跟行

悪い男

tz2302200 发表于 2019-6-14 17:19
天霸商务宾馆A座光交(小区光交-)-178.xls
这样？

参考你的第一段代码后已经百度了下，自行修改完成了，谢谢

1. Sub 重命名()
   
2. Dim MyName$
   
3. Dim varFileList As Variant
   
4. 
   
5. MsgBox "选择要重命名文件所在的文件夹,点击确定！"
   
6. With Application.FileDialog(msoFileDialogFolderPicker)
   
7.     .AllowMultiSelect = False
   
8.     .Show
   
9.     If .SelectedItems.Count = 0 Then Exit Sub '未选择文件夹
   
10.     renamepath = .SelectedItems(1)
    
11.     If Right(renamepath, 1) <> "" Then
    
12.         renamepath = renamepath + ""
    
13.     End If
    
14. End With
    
15. 
    
16. '获取文件夹中的所有文件列表
    
17. varFileList = fcnGetFileList(renamepath)
    
18. 
    
19. If Not IsArray(varFileList) Then
    
20.     MsgBox "未找到文件，请重新点击！", vbInformation
    
21.     Exit Sub
    
22. End If
    
23. 
    
24.     MyName = Dir(renamepath & "*.xls")
    
25.     For l = 0 To UBound(varFileList)
    
26.     Dim fs
    
27.     Set fs = CreateObject("Scripting.FileSystemObject")
    
28.         With Workbooks.Open(renamepath & MyName)
    
29.             .Sheets(1).Select
    
30.             CC = Application.CountA(ActiveSheet.Range("C:C")) - 1
    
31.             .Close True
    
32.         End With
    
33.         oName = renamepath & CStr(varFileList(l))
    
34.         nName = Left(MyName, Len(MyName) - 4) & "-" & CC & ".xls"
    
35.         Name oName As nName
    
36.         MyName = Dir
    
37.     Next l
    
38. Application.ScreenUpdating = True
    
39. MsgBox "全部重命名成功！", vbInformation
    
40. 
    
41. End Sub
    
42. 
    
43. Private Function fcnGetFileList(ByVal strPath As String, Optional strFilter As String) As Variant
    
44. ' 将文件列表放到数组
    
45. Dim f As String
    
46. Dim i As Integer
    
47. Dim FileList() As String
    
48. 
    
49. If strFilter = "" Then strFilter = "*.*"
    
50.     Select Case Right(strPath, 1)
    
51.     Case "", "/"
    
52.     strPath = Left(strPath, Len(strPath) - 1)
    
53. End Select
    
54. 
    
55. ReDim Preserve FileList(0)
    
56. f = Dir(strPath & "" & strFilter)
    
57. Do While Len(f) > 0
    
58.     ReDim Preserve FileList(i) As String
    
59.     FileList(i) = f
    
60.     i = i + 1
    
61.     f = Dir()
    
62. Loop
    
63. If FileList(0) <> Empty Then
    
64.     fcnGetFileList = FileList
    
65. Else
    
66.     fcnGetFileList = False
    
67. End If
    
68. 
    
69. End Function
    

复制代码