[已解决]筛选后取值

wling1228

想实现：
1--从源数据中筛选出“部分”及“降期“的数据后，到第一个sheet中查找到
2--从第一个sheet中查到后，就复制插入整行至它的上一行。
下面代码只能定位到筛选后的第一个数据，第2行数据不知道怎么获取？


Sub test()
Dim id As String
Dim myrow As Integer
Dim x As Integer

Sheets("源数据").Activate
ActiveSheet.Range("A:N").AutoFilter Field:=14, Criteria1:=Array("部分", "降期"), Operator:=xlFilterValues
id = ActiveSheet.Range("C2:C10000").SpecialCells(xlCellTypeVisible).Value
Sheets("逾期明细表0925").Activate
myrow = Range("A:A").Find(id, LookIn:=xlValues).Row
Rows(myrow & ":" & myrow).Select
Selection.Copy
Selection.Insert shift = xlDown

End Sub

最佳答案

月排行榜 / 总排行榜

xdragon

2014-9-30 14:16

1. Sub test()
   
2.     Dim arr, brr, i1%, i2&
   
3.     Application.ScreenUpdating = False
   
4.     arr = Sheet2.Range("A1").CurrentRegion.Value
   
5.     For i1 = 2 To UBound(arr)
   
6.         If arr(i1, 14) = "部分" Or arr(i1, 14) = "降期" Then
   
7.             brr = Sheet1.Range("A1").CurrentRegion.Value
   
8.             For i2 = UBound(brr) To 2 Step -1
   
9.                 If arr(i1, 3) = brr(i2, 1) Then
   
10.                      Sheet1.Rows(i2).Insert
    
11.                      Sheet1.Rows(i2 + 1).Copy Sheet1.Rows(i2)
    
12.                 End If
    
13.             Next
    
14.         End If
    
15.     Next
    
16.     Application.ScreenUpdating = True
    
17. End Sub

复制代码

跳转到最佳答案楼层

xdragon

1. Sub test()
   
2.     Dim arr, brr, i1%, i2&
   
3.     Application.ScreenUpdating = False
   
4.     arr = Sheet2.Range("N1:N" & Sheet2.Cells(Rows.Count, "N").End(xlUp).Row).Value
   
5.     For i1 = 2 To UBound(arr)
   
6.         If arr(i1, 1) = "部分" Or arr(i1, 1) = "降期" Then
   
7.             brr = Sheet1.Range("Y1:Y" & Sheet1.Cells(Rows.Count, "Y").End(xlUp).Row).Value
   
8.             For i2 = UBound(brr) To 2 Step -1
   
9.                 If arr(i1, 1) = brr(i2, 1) Then
   
10.                      Sheet1.Rows(i2).Insert
    
11.                      Sheet2.Rows(i1).Copy Sheet1.Rows(i2)
    
12.                 End If
    
13.             Next
    
14.         End If
    
15.     Next
    
16.     Application.ScreenUpdating = True
    
17. End Sub

复制代码

不知道是不是这个意思，行比较多，有点卡哈

wling1228

xdragon 发表于 2014-9-30 13:29
不知道是不是这个意思，行比较多，有点卡哈

谢谢，不过不是这个意思哦。
就是在“源数据”找到了第4&5两列符合了要求后，用C列的身份证号去第1个sheet中找，找到了的话就复制一条一样的数据：
如第4列的111111111身份证号码符合条件，到第1个sheet中找到第一个111111111在第14行，然后复制整个14行的数据插入到14行的上面。

xdragon

1. Sub test()
   
2.     Dim arr, brr, i1%, i2&
   
3.     Application.ScreenUpdating = False
   
4.     arr = Sheet2.Range("A1").CurrentRegion.Value
   
5.     For i1 = 2 To UBound(arr)
   
6.         If arr(i1, 14) = "部分" Or arr(i1, 14) = "降期" Then
   
7.             brr = Sheet1.Range("A1").CurrentRegion.Value
   
8.             For i2 = UBound(brr) To 2 Step -1
   
9.                 If arr(i1, 3) = brr(i2, 1) Then
   
10.                      Sheet1.Rows(i2).Insert
    
11.                      Sheet1.Rows(i2 + 1).Copy Sheet1.Rows(i2)
    
12.                 End If
    
13.             Next
    
14.         End If
    
15.     Next
    
16.     Application.ScreenUpdating = True
    
17. End Sub

复制代码