如何导入合并了多个单元格的excel工作表

Question

我有一个允许用户上传工作表的VBA代码(如下所示)。但是，工作表有时可以有许多合并的单元格。上传过程需要5-6分钟才能完成。无论如何，使用VBA加速上传？此外，合并后的单元格是空白的，因此可以忽略它们。

Sub Upload()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim lastRow As Integer
Dim LastColumn As Integer

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File         
& Import Range", FileFilter:="Excel Files (*.xls*),*xls")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
Set src = OpenBook.Sheets(1)
src.Copy Before:=ThisWorkbook.Sheets(1)
OpenBook.Close False
End If

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub

Answer 1

我使用以下代码将合并的单元格更改为“居中选择”单元格：

Sub fixMergedCells(sh As Worksheet)
'replace merged cells by Center Across Selection
'superfast version using a hack: https://stackoverflow.com/a/9452164/78522
    Dim c As Range, used As Range
    Dim m As Range, i As Long
    Dim constFla: constFla = Array(xlConstants, xlFormulas)
    
    Set used = sh.UsedRange
    For i = 0 To 1                               '1 run for constants, 1 for formulas
        Err.Clear
        On Error Resume Next
        Set m = Intersect(used.Cells.SpecialCells(constFla(i)), used.Cells.SpecialCells(xlBlanks))
        On Error GoTo 0
        If Not m Is Nothing Then
            For Each c In m.Cells
                If c.MergeCells Then
                    With c.MergeArea
                        'Debug.Print .Address
                        .UnMerge
                        .HorizontalAlignment = xlCenterAcrossSelection
                    End With
                End If
            Next c
        End If
    Next i
End Sub