再次求助，删除行（如果有相同的数字）

F1shanghai · 发表于 2007-1-1 16:52

Private Sub CommandButton2_Click()
Dim a As Integer
a = Sheet2.[a65536].End(xlUp).Row
For i = 2 To a
If Sheet2.Range("a" & i) = Sheet2.Range("b" & i).Value Or _
Sheet2.Range("a" & i) = Sheet2.Range("c" & i) Or _
Sheet2.Range("a" & i) = Sheet2.Range("d" & i) Or _
Sheet2.Range("a" & i) = Sheet2.Range("e" & i) Or _
Sheet2.Range("b" & i) = Sheet2.Range("c" & i) Or _
Sheet2.Range("b" & i) = Sheet2.Range("d" & i) Or _
Sheet2.Range("b" & i) = Sheet2.Range("e" & i) Or _
Sheet2.Range("c" & i) = Sheet2.Range("d" & i) Or _
Sheet2.Range("c" & i) = Sheet2.Range("e" & i) Or _
Sheet2.Range("d" & i) = Sheet2.Range("e" & i) Then
Sheet2.Rows(i).Select
Selection.Delete Shift:=xlUp
End If
Next
End Sub 43JAAh6T.rar (50.38 KB, 下载次数: 17)

黄色为错误部分，不清楚，VBA刚开始学……

看书不如实践

yvhf · 发表于 2007-1-1 17:29

If Sheet2.Range("a" & i) = Sheet2.Range("b" & i).Value Or _
Sheet2.Range("a" & i) = Sheet2.Range("c" & i) Or _
Sheet2.Range("a" & i) = Sheet2.Range("d" & i) Or _
Sheet2.Range("a" & i) = Sheet2.Range("e" & i) Or _
Sheet2.Range("b" & i) = Sheet2.Range("c" & i) Or _
Sheet2.Range("b" & i) = Sheet2.Range("d" & i) Or _
Sheet2.Range("b" & i) = Sheet2.Range("e" & i) Or _
Sheet2.Range("c" & i) = Sheet2.Range("d" & i) Or _
Sheet2.Range("c" & i) = Sheet2.Range("e" & i) Or _
Sheet2.Range("d" & i) = Sheet2.Range("e" & i) Then
这样的表达太过笨拙了，调用一个countif函数，出错是因为，要选择别表单元格前，好像应该选激活单元格

yvhf · 发表于 2007-1-1 17:51

Sub CommandButton2_Click()
Dim a%, b%, I%, p%
Application.ScreenUpdating = False '关闭屏幕刷新，速度会快一点
a = Sheet2.[a65536].End(xlUp).Row
For I = a To 2 Step -1
     For p = 1 To 5
        If Application.WorksheetFunction.CountIf(Sheet2.Range(Sheet2.Cells(I, 1), Sheet2.Cells(I, 5)), Sheet2.Cells(I, p).Value) > 1 Then Sheet2.Rows(I).Delete
      Next p
Next I
Application.ScreenUpdating = True
End Sub

那个删除的代码，试一下

drinkcrow · 发表于 2007-1-1 18:56

Private Sub CommandButton2_Click()
Dim a As Long, i As Long
Dim d() As Variant
Dim j As Integer, k As Integer
Dim rng As Range
t1 = Time()
a = Sheet2.[a65536].End(xlUp).Row
For i = 2 To a
d = Sheet2.Range("a" & i & ":e" & i).Value

For j = LBound(d, 2) To UBound(d, 2)
For k = j + 1 To UBound(d, 2)
    If d(1, j) = d(1, k) Then
      If rng Is Nothing Then
           Set rng = Sheet2.Rows(i)
       Else
           Set rng = Union(rng, Sheet2.Rows(i))

      End If
       GoTo del
    End If
Next k
Next j
del:
Next i
On Error Resume Next
rng.EntireRow.Delete
t2 = Time()
MsgBox "运行时间：" & FormatDateTime(t2 - t1, 3) & "秒"
End Sub

运行时间： 34秒

drinkcrow · 发表于 2007-1-1 19:26

3楼的运行时间在 1分09秒左右

drinkcrow · 发表于 2007-1-1 20:32

LZ 按钮1的代码换成下面，运行时间只有2秒，快10秒：

Private Sub CommandButton1_Click()
    Dim a%, b%, c%, d%, e%, n%
    Dim V()
    Application.ScreenUpdating = False
    t1 = Time()
    a = Range("a1").End(xlDown).Row - 1
    b = Range("b1").End(xlDown).Row - 1
    c = Range("c1").End(xlDown).Row - 1
    d = Range("d1").End(xlDown).Row - 1
    e = Range("e1").End(xlDown).Row - 1

    n = a * b * c * d * e
    ReDim V(1 To n, 1 To 5)
    For k = 1 To n
        V(k, 1) = Cells(Int(k / (b * c * d * e)) + 2, 1)
        V(k, 2) = Cells(Int(k / (c * d * e) Mod b) + 2, 2)
        V(k, 3) = Cells(Int(k / (d * e) Mod c) + 2, 3)
        V(k, 4) = Cells((Int(k / e) Mod d) + 2, 4)
        V(k, 5) = Cells((k Mod e) + 2, 5)

    Next
Sheet2.Rows("2:" & Sheet2.Range("A" & Cells.Rows.Count).End(xlUp)).ClearContents
Sheet2.Range("a2" & ":e" & n + 1).Value = V
t2 = Time()
MsgBox "运行时间：" & Format(t2 - t1, "nn分ss秒")
Application.ScreenUpdating = True
End Sub

原为：

Private Sub CommandButton11_Click()
    Dim a%, b%, c%, d%, e%, n%
    a = Range("a1").End(xlDown).Row - 1
    b = Range("b1").End(xlDown).Row - 1
    c = Range("c1").End(xlDown).Row - 1
    d = Range("d1").End(xlDown).Row - 1
    e = Range("e1").End(xlDown).Row - 1

    n = a * b * c * d * e
    For k = 0 To n - 1
        Sheets(2).Range("a" & k + 2) = Cells(Int(k / (b * c * d * e)) + 2, 1)
        Sheets(2).Range("b" & k + 2) = Cells(Int(k / (c * d * e) Mod b) + 2, 2)
        Sheets(2).Range("c" & k + 2) = Cells(Int(k / (d * e) Mod c) + 2, 3)
        Sheets(2).Range("d" & k + 2) = Cells((Int(k / e) Mod d) + 2, 4)
        Sheets(2).Range("e" & k + 2) = Cells((k Mod e) + 2, 5)
    Next
End Sub

F1shanghai · 发表于 2007-1-1 20:43

测试过了,方法1: 10秒

方法2: 13秒

具体见附件.谢谢楼上各位兄弟

偶电脑是PM 1.5G; 512M 内存

你也可以测试以下哦^_^.

qNs9bdaO.rar (63.11 KB, 下载次数: 38)

测试前先要"生成数字"

因为刚刚第2种方法已经测试好了,所以是0秒

[此贴子已经被作者于2007-1-1 21:12:52编辑过]

drinkcrow · 发表于 2007-1-1 21:00

我的电脑是　Ｃ1.1　２５６ＭＢ

我的电脑方法1在不需要删除行的情况下（即无重复），也要50秒

方法2则为0秒

yvhf · 发表于 2007-1-1 22:03

我的PIII733　256M　SDR

方法1　：34

方法2　：35

		自动登录	找回密码
密码			免费注册