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

小小玩童

如附件 自动提取数据附件.rar (117.54 KB, 下载次数: 34)

2012-5-4 10:11 上传

点击文件名下载附件
谢谢！

最佳答案

月排行榜 / 总排行榜

liuguansky

2012-5-4 11:31

1. Sub df()
   
2.     Dim Arr, i&, Ar() As Long, j As Byte, K&, A(1 To 2) As Long
   
3.     Arr = [a1].CurrentRegion.Value
   
4.     ReDim Ar(1 To 60000, 1 To UBound(Arr, 2))
   
5.     A(1) = Application.InputBox("ÇëÊäÈëAÁÐҪɸѡµÄÖµ", "È·ÈÏ", [a1], , , , , 1)
   
6.     A(2) = Application.InputBox("ÇëÊäÈëBÁÐҪɸѡµÄÖµ", "È·ÈÏ", [b1], , , , , 1)
   
7.     If A(1) > 0 And A(2) > 0 Then
   
8.         For i = 1 To UBound(Arr)
   
9.             If Arr(i, 1) = A(1) And Arr(i, 2) = A(2) Then
   
10.                 K = K + 1
    
11.                 For j = 1 To UBound(Arr, 2)
    
12.                     Ar(K, j) = Arr(i, j)
    
13.                 Next
    
14.             End If
    
15.         Next i
    
16.     End If
    
17.     With Sheet2
    
18.         .Cells.ClearContents
    
19.         .[a1].Resize(K, UBound(Ar, 2)) = Ar
    
20.     End With
    
21. End Sub

复制代码

跳转到最佳答案楼层

liuguansky

1. Sub df()
   
2.     Dim Arr, i&, Ar() As Long, j As Byte, K&, A(1 To 2) As Long
   
3.     Arr = [a1].CurrentRegion.Value
   
4.     ReDim Ar(1 To 60000, 1 To UBound(Arr, 2))
   
5.     A(1) = Application.InputBox("ÇëÊäÈëAÁÐҪɸѡµÄÖµ", "È·ÈÏ", [a1], , , , , 1)
   
6.     A(2) = Application.InputBox("ÇëÊäÈëBÁÐҪɸѡµÄÖµ", "È·ÈÏ", [b1], , , , , 1)
   
7.     If A(1) > 0 And A(2) > 0 Then
   
8.         For i = 1 To UBound(Arr)
   
9.             If Arr(i, 1) = A(1) And Arr(i, 2) = A(2) Then
   
10.                 K = K + 1
    
11.                 For j = 1 To UBound(Arr, 2)
    
12.                     Ar(K, j) = Arr(i, j)
    
13.                 Next
    
14.             End If
    
15.         Next i
    
16.     End If
    
17.     With Sheet2
    
18.         .Cells.ClearContents
    
19.         .[a1].Resize(K, UBound(Ar, 2)) = Ar
    
20.     End With
    
21. End Sub

复制代码

小小玩童

liuguansky 发表于 2012-5-4 11:31

谢谢版主老师帮助！11111111