[已解决]（求助）如何根据条件提取数据到Sheet2里？

小丽媛

数据附件 自动提取合格数据附件.rar (9.72 KB, 下载次数: 27)

2012-8-9 13:13 上传

点击文件名下载附件

谢谢本坛各位老师！

最佳答案

月排行榜 / 总排行榜

hrpotter

2012-8-9 13:35

1. Sub test()
   
2.     Dim i As Long, j As Long, k As Long
   
3.     Dim num1 As Long, num2 As Long, num3 As Long
   
4.     Dim arr, brr
   
5.     arr = Sheets(1).Range("a1").CurrentRegion
   
6.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
7.     num1 = Val(InputBox("请输入指定第一个任意数："))
   
8.     num2 = Val(InputBox("请输入指定行数："))
   
9.     num3 = Val(InputBox("请输入指定第二个任意数："))
   
10.     For j = 1 To UBound(arr, 2)
    
11.         If arr(1, j) = num1 And arr(num2, j) = num3 Then
    
12.             k = k + 1
    
13.             For i = 1 To UBound(arr)
    
14.                 brr(i, k) = arr(i, j)
    
15.             Next
    
16.         End If
    
17.     Next
    
18.     With Sheets(2)
    
19.         .Cells.Clear
    
20.         If k > 0 Then .Range("a1").Resize(UBound(arr), k) = brr
    
21.     End With
    
22. End Sub

复制代码

跳转到最佳答案楼层

hrpotter

1. Sub test()
   
2.     Dim i As Long, j As Long, k As Long
   
3.     Dim num1 As Long, num2 As Long, num3 As Long
   
4.     Dim arr, brr
   
5.     arr = Sheets(1).Range("a1").CurrentRegion
   
6.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
7.     num1 = Val(InputBox("请输入指定第一个任意数："))
   
8.     num2 = Val(InputBox("请输入指定行数："))
   
9.     num3 = Val(InputBox("请输入指定第二个任意数："))
   
10.     For j = 1 To UBound(arr, 2)
    
11.         If arr(1, j) = num1 And arr(num2, j) = num3 Then
    
12.             k = k + 1
    
13.             For i = 1 To UBound(arr)
    
14.                 brr(i, k) = arr(i, j)
    
15.             Next
    
16.         End If
    
17.     Next
    
18.     With Sheets(2)
    
19.         .Cells.Clear
    
20.         If k > 0 Then .Range("a1").Resize(UBound(arr), k) = brr
    
21.     End With
    
22. End Sub

复制代码

小丽媛

hrpotter 发表于 2012-8-9 13:35

经测试，又快又准。谢谢老师帮助！

hwc2ycy

用inputobx最好还是加上点取消的判断比较好。