多个工作表同时执行同一段VBA代码

桐桐的面包树

请教大神们，如何对多个工作表同时执行同一段VBA代码：

需要批量将多个工作表中的文本格式转化成数值，谢谢~

1. Sub 格式化()
   
2. With Application.Intersect(Selection, ActiveSheet.UsedRange)
   
3. .NumberFormatLocal = ""
   
4. .Value = .Value
   
5. End With
   
6. End Sub

复制代码

liulang0808

逐个表格遍历，然后激活，执行那段代码就可以
但是楼主的代码能解决描述的问题吗

taller

1. Sub 格式化()
   
2.         for each Sht in worksheets
   
3.         With Sht.UsedRange
   
4.                 .NumberFormatLocal = ""
   
5.                 .Value = .Value
   
6.         End With
   
7.         next
   
8. End Sub

复制代码

f8b1987

Sub 循环()
for each sht in sheets
'if sht.name="A" OR sht.name="b" then
call 格式化
'end if
next

End Sub

桐桐的面包树

liulang0808 发表于 2023-1-15 10:56
逐个表格遍历，然后激活，执行那段代码就可以
但是楼主的代码能解决描述的问题吗

这个代码只能一个一个的工作表执行，太麻烦，工作表实在太多，有几百个

桐桐的面包树

f8b1987 发表于 2023-1-15 11:42
Sub 循环()
for each sht in sheets
'if sht.name="A" OR sht.name="b" then

感谢大神，不过这个代码好像还是不行

桐桐的面包树

taller 发表于 2023-1-15 11:22

感谢大神，问题已解，谢谢~

lizhipei78

1. Sub 遍历批处理工作表() '这个是选择文件夹
   
2.     Dim strPath As String, sht As Worksheet
   
3.     Dim strWbName As String, Wb As Workbook
   
4.     With Application
   
5.         .ScreenUpdating = False '取消屏幕刷新
   
6.         .DisplayAlerts = False '取消警告信息
   
7.         .EnableEvents = False '取消事件
   
8.         .Calculation = xlCalculationManual '取消公式重算
   
9.         .AskToUpdateLinks = False '取消外链询问
   
10.     End With
    
11.     With Application.FileDialog(msoFileDialogFolderPicker) '获取文件夹路径
    
12.         If .Show Then strPath = .SelectedItems(1) & "" Else GoTo 100
    
13.     End With
    
14.     On Error Resume Next
    
15.     strWbName = Dir(strPath & "*.xls*")
    
16.     Do While strWbName <> "" 'dir语句遍历excel文件
    
17.         If strWbName <> ThisWorkbook.Name Then
    
18.             Set Wb = Workbooks.Open(strPath & strWbName) '打开工作簿
    
19.             For Each sht In Wb.Worksheets '遍历工作表
    
20.                 sht.Activate
    
21.                 sht.UsedRange.Value = sht.UsedRange.Value
    
22.             Next
    
23.             Wb.Close True '保存关闭工作簿
    
24.         End If
    
25.         strWbName = Dir() '下一个excel文件
    
26.     Loop
    
27.     If Err.Number Then
    
28.         MsgBox Err.Description
    
29.     Else
    
30.         MsgBox "转换完成。"
    
31.     End If
    
32. 100
    
33.     With Application '恢复系统设置
    
34.         .ScreenUpdating = True
    
35.         .DisplayAlerts = True
    
36.         .EnableEvents = True
    
37.         .Calculation = xlCalculationAutomatic
    
38.         .AskToUpdateLinks = True
    
39.     End With
    
40. End Sub
    
41. 
    

复制代码

lizhipei78

1. Sub 批处理() '这个是选择Excel文件
   
2.     Dim strFile, Wb As Workbook, i%, j%, Wjlx As String
   
3.     Dim Rng As Range
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     Wjlx = "Excel文件,*.xls*"
   
7.     strFile = Application.GetOpenFilename(filefilter:=Wjlx, Title:="打开文件", MultiSelect:=True)
   
8.     If Not IsArray(strFile) Then GoTo 300
   
9.     For i = 1 To UBound(strFile)
   
10.         Set Wb = Workbooks.Open(strFile(i))
    
11.         For Each sht In Wb.Worksheets '遍历工作表
    
12.             sht.Activate
    
13.             sht.UsedRange.Value = sht.UsedRange.Value
    
14.         Next
    
15.         Wb.Close savechanges:=True '保存关闭工作簿
    
16.     Next
    
17.     MsgBox "完成"
    
18. 300
    
19.     Application.ScreenUpdating = True
    
20.     Application.DisplayAlerts = True
    
21. End Sub
    
22. 
    

复制代码