取消合并特定文件夹路径中许多工作簿中的所有单元格



这是我使用的代码,但不幸的是它不起作用 我使用的是 Excel 365 和 Windows 10 它卡在Excel界面上,没有显示错误,没有操作或处理,也没有打开文件 请帮助我找到解决方案或为我提供一个现成的 Excel VBA 宏,用于执行与我相同的任务,使用旧的 erp 将其报告导出到 htm 中,然后将它们转换为 excel,然后必须合并所有单元格才能有效地使用它们。

Sub UnmergeAllCellsinWorkbooksinOneFolder()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String, Fnum As Long
Dim mybook As Workbook
Dim CalcMode As Long
Dim sh As Worksheet
Dim ErrorYes As Boolean
'Fill in the pathfolder where the files are
MyPath = "F:Sales Rates"
'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "" Then
MyPath = MyPath & ""
End If
'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xlsx*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If
'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop
'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
On Error GoTo 0
If Not mybook Is Nothing Then

'Change cell value(s) in one worksheet in mybook
On Error Resume Next
With mybook.Worksheets(1)
sh.Cells.MergeCells = False
End With

If Err.Number > 0 Then
ErrorYes = True
Err.Clear
'Close mybook without saving
mybook.Close savechanges:=False
Else
'Save and close mybook
mybook.Close savechanges:=True
End If
On Error GoTo 0
Else
'Not possible to open the workbook
ErrorYes = True
End If
Next Fnum
End If
If ErrorYes = True Then
MsgBox "There are problems in one or more files, possible problem:" _
& vbNewLine & "protected workbook/sheet or a sheet/range that not exist"
End If
'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub

sh什么都不是。我认为它应该修复如下。

With mybook.Worksheets(1)
'sh.Cells.MergeCells = False
.Cells.MergeCells = False
End With

最新更新