Question

我试图让Macro工作合并具有重复数据的单元格。它将适用于少量单元格，但如果我尝试在更大的单元格组上运行它，我会收到以下错误。我不确定是否有更好的方法让excel能够完成此任务。

运行时错误＆＃39; 1004＆＃39;：方法＆＃39;范围＆＃39;对象＆＃39; _Global＆＃39;

失败了

以下是代码：

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

我使用您发布的代码重新创建了该问题，这对我有用。我做了你的建议并将合并放入For循环中。然后我使用逗号作为分隔符拆分strMyRange。我设置了一个测试来寻找＆＃34;：＆＃34; TestArray（0）中的字符。如果它在那个目标字符串中，那么我知道它已准备好进行合并。之后我将strMyRange重置为TestArray（1），这是下一个范围的开始。

注意：我能够使用100个单元格的调试器逐步完成它并且它可以工作。然后我尝试在没有任何代码断点的情况下运行它，但它合并了所有选定的单元格。我在最终合并之前放了1秒等待声明，这似乎有效。

以下是代码：

 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

合并具有重复数据VBA的单元格

1 个答案: