文件夹下多个EXCEL薄，每个薄有多个表，求VBA一次性取消所有合并单元格

发布网友 发布时间：2023-04-24 18:08

我来回答

共4个回答

热心网友 时间：2023-11-03 23:38

给你一段核心代码，是查找单一工作表内所有合并单元格的。再取消合并单元格。

你自己百度学习学习，找找多工作簿多工作表怎么循环进行。

Sub UnMergeCells()
  Dim FindStr As String, Rng As Range, mRng As Range
  Application.FindFormat.Clear  
  Application.FindFormat.MergeCells = True  
  With Cells
    Set Rng = .Find(What:="", LookIn:=xlFormulas, LookAt:=xlPart, SearchFormat:=True)  '按格式查找
    If Rng Is Nothing Then MsgBox "没有合并单元格": Exit Sub  
    Set mRng = Rng  
    FindStr = Rng.Address  
    Do
      Set mRng = Union(mRng, Rng)  
      Set Rng = .Find(What:="", After:=Rng, SearchFormat:=True)  
    Loop While FindStr <> Rng.Address  
    mRng.unmerge  
  End With
End Sub

热心网友 时间：2023-11-03 23:39

如下代码，修改文件夹名称即可，

Sub programX()
Application.DisplayAlerts = False: Application.ScreenUpdating = False: ChengXuWenjianMing = ActiveWorkbook.Name
JiLuBiao = ActiveSheet.Name: Cells.ClearContents
WenJianJiaMingCheng =
"C:\LiangYouFu\ImportantBackup\" '反斜杠不可省略
WenJianMing = Dir(WenJianJiaMingCheng)
Do While WenJianMing <> ""

ChuLiShuJu WenJianJiaMingCheng, WenJianMing, ChengXuWenjianMing, JiLuBiao
WenJianMing = Dir
Loop
MsgBox "OK"
End Sub
Sub ChuLiShuJu(WenJianJiaMingCheng, WenJianMing, ChengXuWenjianMing, JiLuBiao)
On Error Resume Next

Workbooks.Open WenJianJiaMingCheng & WenJianMing
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
sh.Cells.UnMerge
Next
Windows(WenJianMing).Close savechanges:=True
End Sub

热心网友 时间：2023-11-03 23:39

excel只能合并连续的规则块，不能同时分别合并多个不连续区域的块。如果你的这些块都是固定的，倒是可以考虑录制一个宏，在宏操作中依次合并这些要合并的区块，并为宏指定一个快捷键，以后用快捷键就可以了。要是想对不固定的多个数据区同时实现合并，只有通过vba来实现。追问我要取消所有合并单元格，不是合并

热心网友 时间：2023-11-03 23:40

留个邮箱，回头发给你！