都辛苦了,真不知采纳谁的啊。数据是用函数公式得到的。怎样能给大家都加分啊?
ALT+F11打开VBA,插入模块,粘贴以下代码,F5运行。
Sub test()
Dim j, k As Integer
Sheet1.Activate
j = Range("a65535").End(xlUp).Row
For i = j To 1 Step -1
hv = Cells(i, 8)
If hv = 6 Then
Cells(j - k, 9) = Cells(i, 1)
Cells(j - k, 10) = Cells(i, 2)
Cells(j - k, 11) = Cells(i, 3)
Cells(j - k, 12) = Cells(i, 4)
Cells(j - k, 13) = Cells(i, 5)
Cells(j - k, 14) = Cells(i, 6)
Cells(j - k, 15) = Cells(i, 7)
Cells(j - k, 16) = Cells(i, 8)
k = k + 1
End If
Next
End Sub
Sub abc1()
i = Range("H65535").End(xlUp).Row
For j = i To 1 Step -1
If Cells(j, 8) = 6 Then
Cells(i, 10) = Cells(j, 2)
Cells(i, 11) = Cells(j, 3)
Cells(i, 12) = Cells(j, 4)
Cells(i, 13) = Cells(j, 5)
Cells(i, 14) = Cells(j, 6)
Cells(i, 15) = Cells(j, 7)
Cells(i, 16) = Cells(j, 8)
i = i - 1
End If
Next
End Sub
试了一下,太慢了。要VBA是想快一点。几百行数据要了2分多钟。
追答不会吧,我刚试了一下,423行,秒定啊。你查一下,是否文件太大或别的原因?
要么,把你的附件传上来看看。
刚试了6000行也没超过3秒呀?
你查查别的原因吧!
下载你的表很快。复制到我的表上就变慢了。是不是因为我的表中还有别的函数公式,就变慢了?
追答有可能,方便的话,你可以传上来看看??
你把代码改一下试试看
如:Cells(i, 10) = Cells(j, 2)改为Cells(i, 10).Value = Cells(j, 2).Value
别的都类似改一下,再试。
使用以下代码可完成:
Sub test()Dim RES()
Dim MC, C1
Data = Range("b1:g23")
Count = Application.WorksheetFunction.CountIf(Range("g1:g23"), "=6")
MC = UBound(Data, 1)
ReDim RES(1 To Count, 1 To 6)
CA = 0
For i = 1 To MC
If Data(i, 6) = 6 Then
C1 = C1 + 1
For j = 1 To 6
RES(C1, j) = Data(i, j)
Next j
End If
Next i
With Range("i1")
Range(.Offset(MC - Count, 0), .Offset(MC - 1, 6 - 1)) = RES
End With
End Sub追问
我有几百行数据。好象不对。
追答这个数组的方法是比较快的,至于几百行数据,是需要将以下代码改动一下
Data = Range("b1:g23")Count = Application.WorksheetFunction.CountIf(Range("g1:g23"), "=6")
例如有9999行数据,改成如下即可:
Data = Range("b1:g9999")Count = Application.WorksheetFunction.CountIf(Range("g1:g9999"), "=6")
数下吧。又大又黑的5,6是H列。
追答Sub sdgsdhd()
a = Cells(65536, 2).End(xlUp).Row
b = a
For i = a To 1 Step -1
If Cells(i, 8).Value = 6 Then
Range(Cells(b, 10), Cells(b, 16)).Value = Range(Cells(i, 2), Cells(i, 8)).Value
b = b - 1
End If
Next
End Sub
试了一下,太慢了,几百行数据要了2分多钟。要VBA是想快点。
追答老兄,那是你的电脑慢好不好,我设68行数据,一秒搞定。
就这几个人,在单元格做个随机数呗,你照随机数给就行了。