因为数据提取重复，所以想用VBA删除多余，求大神帮助。

贺达勇

原因：因为数据提取重复，所以想用VBA删除多余的  1：怎么从W4到AB7删除，然后每隔四行删除多余的，就是示例黄色部分的不要可能要到3000行左右；     
2：怎么从AD4到AI8删除，然后每隔五行删除多余的，就是示例黄色部分的不要，可能要到3000行左右；  
求大神帮助我一下。

wodewan

Sub test()
Dim arr, brr, i&, j&, m&
arr = [W1:AB10000]: brr = [AD1:AI10000]
Call JS(arr, 4, 0)
Call JS(brr, 5, 1)
[W1:AB10000].Clear: [AD1:AI10000].Clear
[w1].Resize(UBound(arr), 6) = arr
[AD1].Resize(UBound(arr), 6) = brr
End Sub

Sub JS(arr, x, y)
Dim i&, j&, m&
For i = 1 To UBound(arr)
    If ((i + y) \ x) Mod 2 Then
    Else
        m = m + 1
        For j = 1 To 6
            arr(m, j) = arr(i, j)
        Next
    End If
Next
End Sub

1414675912

wodewan 发表于 2020-3-14 20:30
Sub test()
Dim arr, brr, i&, j&, m&
arr = [W1:AB10000]: brr = [AD1:AI10000]

为什么最后全删完了

贺达勇

wodewan 发表于 2020-3-14 20:30
Sub test()
Dim arr, brr, i&, j&, m&
arr = [W1:AB10000]: brr = [AD1:AI10000]

谢谢大神，谢谢，给你点个赞，搞定了我的求助。

贺达勇

1414675912 发表于 2020-3-14 20:59
为什么最后全删完了

你看下我的原资料，有可能最后我本来就没有数据吧，这部分我原始资料有误；大神做的是对的。

贺达勇

wodewan 发表于 2020-3-14 20:30
Sub test()
Dim arr, brr, i&, j&, m&
arr = [W1:AB10000]: brr = [AD1:AI10000]

对不起，那天因为我的我 就两朵花了， 只给了你一朵，我怕我再有其它问题，人家回复了，就没花给了，到时就没脸了，希望你 不要在意。