合并单元格与重复的数据VBA

我试图让一个macros工作合并单元格与重复的数据。 它将在less量的单元格上工作，但如果我尝试在更大的单元格上运行它，则会出现以下错误。 我不确定是否有一个更有效的方式让Excel运行。

运行时错误'1004'：对象'_Global'的方法'范围'失败

代码如下：

Sub MergeDuplicates() Dim varData As Variant, varContent As Variant Dim strMyRange As String Application.ScreenUpdating = False Application.DisplayAlerts = False strMyRange = ActiveCell.Address varContent = ActiveCell.Value For Each varData In Selection.Cells If varData.Value <> varContent Then strMyRange = strMyRange & ":" & Cells(varData.Row - 1, varData.Column).Address & ", " & Cells(varData.Row, varData.Column).Address varContent = Cells(varData.Row, varData.Column).Value End If Next strMyRange = strMyRange & Mid(Selection.Address, InStr(1, Selection.Address, ":"), Len(Selection.Address)) Range(strMyRange).Merge Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub 

Answer 1

我已经使用您发布的代码重新创build了该问题，并且正在为我工​​作。 我做了你的build议，并把合并到For循环。 然后我使用逗号作为分隔符来分割strMyRange。 我设置了一个testing来查找TestArray（0）中的“：”字符。 如果它在目标string中，那么我知道它已经为合并做好了准备。 之后，我重置strMyRange到下一个范围的开始TestArray（1）。

注意：我能够用100个单元的debugging器来完成它，它工作。 然后我尝试运行它没有任何代码断点，但它合并所有选定的单元格。 我在最后合并之前提出了一秒钟的等待声明，似乎有效。

这里是代码：

  Sub MergeDuplicates() Dim varData As Variant, varContent As Variant Dim strMyRange As String Dim TestArray() As String Dim target As String Dim pos As Integer Application.ScreenUpdating = False Application.DisplayAlerts = False strMyRange = ActiveCell.Address varContent = ActiveCell.Value For Each varData In Selection.Cells If varData.Value <> varContent Then strMyRange = strMyRange & ":" & Cells(varData.Row - 1, varData.Column).Address & ", " & Cells(varData.Row, varData.Column).Address TestArray = Split(strMyRange, ",") target = TestArray(0) pos = InStr(target, ":") If (pos > 0) Then Range(target).Merge strMyRange = TestArray(1) End If varContent = Cells(varData.Row, varData.Column).Value End If Next strMyRange = strMyRange & Mid(Selection.Address, InStr(1, Selection.Address, ":"), Len(Selection.Address)) Application.Wait (Now + #12:00:01 AM#) 'This helps the application run OK if there are no breakpoints. Range(strMyRange).Merge Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub