Sub BatchChangeFormatOfExcel() Dim time1 As Date Dim time2 As Date time1 = Timer ' 计时 Dim xFd As FileDialog Dim xSPath As String Dim xExcelFile As String Application.DisplayAlerts = False Application.StatusBar = True Set xFd = Application.FileDialog(msoFileDialogFolderPicker) xFd.Title = "Select a folder:" If xFd.Show = -1 Then xSPath = xFd.SelectedItems(1) Else Exit Sub End If If Right(xSPath, 1) <> "\" Then xSPath = xSPath + "\" xExcelFile = Dir(xSPath & "*.xlsx") Do While xExcelFile <> "" Application.StatusBar = "Changing: " & xExcelFile ' 打开表格 Dim wB As Workbook Set wB = Workbooks.Open(Filename:=xSPath & xExcelFile) Dim myRange As Range Dim myFont As Font ' 获取表格及要修改的列 Set myRange = wB.Worksheets("Sheet1").Range("A1:E1") myRange.Merge ' 合并 Set myFont = myRange.Font ' 获取字体 With myFont ' 修改字体 .Name = "华文新魏" .Size = 20 .Bold = True End With ' 居中显示 myRange.HorizontalAlignment = xlCenter ' 设置列格式 wB.Worksheets("Sheet1").Range("A:D").EntireColumn.NumberFormatLocal = "0000.000" ' 保存并关闭 wB.Save wB.Close ' 获取下一个xlsx文件 xExcelFile = Dir Loop Application.StatusBar = False Application.DisplayAlerts = True ' 处理完毕提示,及总耗时 time2 = Timer MsgBox "Finished!" & " Cost Time: " & Format(time2 - time1, "Fixed") & " s." End Sub