[已解决]提取等于M2的信息

zss7758258

请教.zip (10.59 KB, 下载次数: 7)

2014-4-13 11:48 上传

点击文件名下载附件

请老师们赐教

最佳答案

月排行榜 / 总排行榜

dsmch

2014-4-13 12:53

Sub Macro1()
Dim arr, i&, y%, s&
arr = Range("a1").CurrentRegion
x = [m2]: y = UBound(arr, 2): s = 1
For i = 2 To UBound(arr)
    If arr(i, 1) = x Then s = s + 1: Cells(i, 1).Resize(1, y).Copy Cells(s, 1)
Next
Range(Cells(s + 1, 1), Cells(UBound(arr) + 1, y)).Clear
End Sub

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, i&, y%, s&
   
3. arr = Range("a1").CurrentRegion
   
4. x = [m2]: y = UBound(arr, 2): s = 1
   
5. For i = 2 To UBound(arr)
   
6.     If arr(i, 1) = x Then s = s + 1: Cells(i, 1).Resize(1, y).Copy Cells(s, 1)
   
7. Next
   
8. Range(Cells(s + 1, 1), Cells(UBound(arr), y)).Clear
   
9. End Sub
   

复制代码

dsmch

1. Sub Macro2()
   
2. [a1].AutoFilter Field:=1, Criteria1:="<>" & [m2]
   
3. Range("A2:E" & Range("a65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
   
4. ActiveSheet.ShowAllData
   
5. End Sub
   

复制代码

zss7758258

dsmch 发表于 2014-4-13 12:14

老师，您这2个代码很好，非常符合我的想法，但是有一点，如果A列中的数字全部等于M2的时候，每执行一次宏，会删除一行
复件 请教.zip (10.31 KB, 下载次数: 5)

2014-4-13 12:30 上传

点击文件名下载附件

huangcaiguang

index

huangcaiguang

或者录一个高級筛选宏

zss7758258

huangcaiguang 发表于 2014-4-13 12:33
或者录一个高級筛选宏

我不会耶，有图片示意吗？{:011:}

dsmch

Sub Macro1()
Dim arr, i&, y%, s&
arr = Range("a1").CurrentRegion
x = [m2]: y = UBound(arr, 2): s = 1
For i = 2 To UBound(arr)
    If arr(i, 1) = x Then s = s + 1: Cells(i, 1).Resize(1, y).Copy Cells(s, 1)
Next
Range(Cells(s + 1, 1), Cells(UBound(arr) + 1, y)).Clear
End Sub

zss7758258

dsmch 发表于 2014-4-13 12:53
Sub Macro1()
Dim arr, i&, y%, s&
arr = Range("a1").CurrentRegion

有上万行的信息就变慢了，将就着用，先给老师最佳答案。希望老师能抽空做个提高速度的给我。

dsmch

15000条数据运行0.15s

1. Sub Macro2()
   
2. t = Timer
   
3. ActiveSheet.UsedRange.Clear
   
4. With Sheet3
   
5.     .[a1].AutoFilter Field:=1, Criteria1:="=" & .[m2]
   
6.     .[a:e].Copy [a1]
   
7.     .ShowAllData
   
8. End With
   
9. MsgBox Timer - t
   
10. End Sub
    

复制代码

………………