如何以更快的方式遍历合并的单元格

时间:2019-05-10 08:41:52

标签: excel vba

我在工作表中“散布”了单元格,没有任何模式。
我需要将空白合并的单元格替换为“-”;破折号。

有比这更快的方法吗?

Sub ReplaceblankMergedCells()
    Dim c As Range
    Dim startcolumn, endcolumn, startrow, endrow As Long
    For Each c In ActiveSheet.UsedRange
        If c.MergeCells Then
            If c.Value = "" Then
                c.Value = "_"
            End If
        End If
    Next
End Sub

2 个答案:

答案 0 :(得分:0)

我认为您可以分解整个范围以检入块,并检查每个块中是否包含合并的单元格。在此为假的情况下,您不必检查此类块中的每个单元,从而节省了时间。您节省多少时间(如果有的话)将取决于您的设置和您指定的块数量。

Option Explicit

Sub ReplaceblankMergedCells()
Dim c As Range, r As Range
Dim startcolumn As Long, endcolumn As Long, startrow As Long, endrow As Long
Dim totalchunks As Integer, chunkcols As Integer, i As Integer

With Sheet2 'Edit

    startcolumn = 1
    endcolumn = 50
    startrow = 2
    endrow = 1000
    totalchunks = 10 'set amount of chunks
    chunkcols = Application.WorksheetFunction.RoundUp((endcolumn - startcolumn + 1) / totalchunks , 0) '10 chunks of 5 columns

    For i = startcolumn To endcolumn Step chunkcols
        Set r = .Range(.Cells(startrow, i), .Cells(endrow, i + chunkcols - 1))

        'Prevent the loop from overshooting the last column
        If i + chunkcols - 1 > endcolumn Then Set r = .Range(.Cells(startrow, i), .Cells(endrow, endcolumn))
        'check if the chunk contains merged cells
        If IsNull(r.MergeCells) = True Or r.MergeCells = True Then
            'If it does contain merged cells, loop through the chunk
            For Each c In r
                If c.MergeCells And c.Value = "" Then c.Value = "_"
            Next c
        End If
    Next i

End With
End Sub

您可以(希望)知道,我将设定范围除以十。如果该范围内的列总数为50,则会将范围分成5行的10个相等部分。

我建议您尝试这些块应该有多大。您还可以水平地将更多块拆分为多个块,例如,一个子块中的一半行,另一子块中的另一半行。

答案 1 :(得分:0)

指定您的工作表或更改工作表的确定,看看是否适合您...

Public Sub ReplaceMergeCellsWithHyphen()
    Dim objCells As Range, objCell As Range, objDict As New Scripting.Dictionary
    Dim strRange As String, objSheet As Worksheet

    Set objSheet = Worksheets("Sheet1")

    Set objCells = objSheet.Range("A1:" & objSheet.Cells.SpecialCells(xlCellTypeLastCell).Address)

    For Each objCell In objCells
        If objCell.MergeArea.Cells.Count > 1 Then
            If Not objDict.Exists(objCell.MergeArea.Address) Then objDict.Add objCell.MergeArea.Address, ""
        End If
    Next

    With objSheet
        For i = 0 To objDict.Count - 1
            strRange = objDict.Keys(i)

            If .Range(strRange).Cells(1, 1).Value = "" Then
                .Range(strRange).Cells(1, 1).Value = "-"
            End If
        Next
    End With
End Sub

在图像中可能很难看到,但是在运行宏之后,没有值的合并单元格会用连字符填充。

不确定是否需要更快的速度,但是它可以工作并且(我认为)是否足够健壮。

enter image description here