[已解决]请修改代码

ymq123

    1、sheets(2)表中每一行都和sheets(1)表中每一行相比较，若有5个及以上相同的数字，就删除sheets(2)表中相应的行。如：sheets(2)表第二行和sheets(1)表第一行有6个相同的数字（相同数字是1、3、7、8、10、11），就删除sheets(2)表第二行数字。Sheets(2)表中红字是符合删除条件的行。
    2、我编写的代码看是符合逻辑，运行时就出错。请老师帮助修改主。

最佳答案

月排行榜 / 总排行榜

zjdh

2013-12-11 19:50

Private Sub CommandButton1_Click()
    Dim ar1, ar2, re, y%, x%, mm%
    Dim i As Integer, j As Integer, m As Integer, r As Integer
    ar1 = Range(Cells(1, 1), Cells(4, 15))
    ar2 = Sheets(2).Range(Sheets(2).Cells(1, 1), Sheets(2).Cells(8, 15))
    ReDim re(1 To UBound(ar2), 1 To 15)
    r = 0
    For mm = 1 To UBound(ar2)
        For x = 1 To UBound(ar1)
            m = 0
            For i = 1 To 15
                If ar1(x, i) = ar2(mm, i) And ar2(mm, i) <> "" Then
                    m = m + 1
                End If
            Next i
            If m > 5 Then Exit For
        Next x
        If x > UBound(ar1) Then
            r = r + 1
            For j = 1 To 15
                re(r, j) = ar2(mm, j)
            Next j
        End If
    Next mm
    If r > 0 Then Sheets(2).Cells(1, 18).Resize(r, 15) = re
End Sub

跳转到最佳答案楼层

excel-work

顶起

ymq123

excel-work 发表于 2013-12-11 19:39
顶起

这是什么意思

zjdh

Private Sub CommandButton1_Click()
    Dim ar1, ar2, re, y%, x%, mm%
    Dim i As Integer, j As Integer, m As Integer, r As Integer
    ar1 = Range(Cells(1, 1), Cells(4, 15))
    ar2 = Sheets(2).Range(Sheets(2).Cells(1, 1), Sheets(2).Cells(8, 15))
    ReDim re(1 To UBound(ar2), 1 To 15)
    r = 0
    For mm = 1 To UBound(ar2)
        For x = 1 To UBound(ar1)
            m = 0
            For i = 1 To 15
                If ar1(x, i) = ar2(mm, i) And ar2(mm, i) <> "" Then
                    m = m + 1
                End If
            Next i
            If m > 5 Then Exit For
        Next x
        If x > UBound(ar1) Then
            r = r + 1
            For j = 1 To 15
                re(r, j) = ar2(mm, j)
            Next j
        End If
    Next mm
    If r > 0 Then Sheets(2).Cells(1, 18).Resize(r, 15) = re
End Sub

ymq123

zjdh 发表于 2013-12-11 19:50
Private Sub CommandButton1_Click()
    Dim ar1, ar2, re, y%, x%, mm%
    Dim i As Integer, j As  ...

老师你好：运行代码时，sheets(2)表中第四行有5个数字和sheets(2)表中第一行相同，也符合条件，却没有被删除。请修改主。谢谢
sheets(2)表中第四行如下：

1

3

5

7

9

10

11

zjdh

我以为要6个呢！
把
If m > 5 Then Exit For
改为
If m > 4 Then Exit For

ymq123

zjdh 发表于 2013-12-11 20:48
我以为要6个呢！
把
If m > 5 Then Exit For

还要麻烦你：代码中x > UBound(ar1)是什么意思？ x是什么变量？
谢谢
If x > UBound(ar1) Then
             r = r + 1
             For j = 1 To 15
                 re(r, j) = ar2(mm, j)
             Next j
         End If

zjdh

x 是上一个循环的变量，当循环结束时（未找到>4个相同的数据），则x > UBound(ar1)。

excel-work

excel-work 发表于 2013-12-11 19:39
顶起

帮你一起寻求帮助