修改代码

ddz79101

老师！我想希望对2种情况：1上下单元格一致:；2上下单元格簿一致情况，各写2个代码，但第1个代码就不行，无反应。请老师帮忙看看。谢谢！

gwjkkkkk

Option Explicit
Sub test1()
    Dim ar, br, i&, j&, p&, n&, k&, r&
    With [A1].CurrentRegion
        .Interior.ColorIndex = xlNone
        ar = .Resize(.Rows.Count + 1)
        br = ar
    End With
   
    p = 2: r = 1
    For i = 2 To UBound(ar) - 1
        If ar(i + 1, 7) <> ar(p, 7) Then
            If i = p Then
                r = r + 1
                For j = 1 To UBound(ar, 2)
                    ar(r, j) = ar(i, j)
                Next j
            End If
            p = i + 1
        End If
    Next i
    Columns("j:P").Clear
    [J1].Resize(r, UBound(ar, 2)) = ar
   
    p = 2: r = 1
    For i = 2 To UBound(br) - 1
        If br(i + 1, 7) <> br(p, 7) Then
            If i <> p Then
                For k = p To i
                    r = r + 1
                    For j = 1 To UBound(br, 2)
                        br(r, j) = br(k, j)
                    Next j
                Next k
            End If
            p = i + 1
        End If
    Next i
    Columns("S:Y").Clear
    [S1].Resize(r, UBound(br, 2)) = br
End Sub

gwjkkkkk

请参考附件。。。

ddz79101

gwjkkkkk 发表于 2024-4-4 09:11
请参考附件。。。

谢谢老师！运行正确