Question

基本上我正在尝试检查文件夹中的工作簿（大约12个工作簿），这些工作簿中的某些工作表已经合并了单元格，我想要取消合并并用最高的值填充它们。以下是我的尝试。

如果我将以下代码用于单个工作簿，则可以正常工作。

Dataset[Row]

检查所有工作簿并执行此代码，我尝试了以下方法，但并没有真正做任何事情，感谢有人可以帮助我。

map

Answer 1

合并一组单元格时，仅保留最高值。

打开您要处理的所有工作簿。然后运行UnMergeCellsOfAllOpenWorkbooks（）

Sub UnMergeCellsOfAllOpenWorkbooks()
    Dim wb As Workbook
    Dim ws As Worksheet
    For Each wb In Workbooks
        For Each ws In wb.Worksheets
            ws.Cells.MergeCells = False
        Next
    Next
End Sub

Answer 2

我会遍历文件夹中的所有文件，打开每个文件，进行更改，在这种情况下取消合并单元格，然后保存更改并逐个关闭文件。

Sub Example()
    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 path\folder where the files are
    MyPath = "C:\Users\Ron\test"

    '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 & "*.xl*")
    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

如何遍历文件夹中的工作簿并取消合并单元格并填充它们

2 个答案: