要求:表2中J列為條件,符合條件的行全部復(fù)制到表1中 不解釋,直接上兩段代碼,SHEET2中第十列,也就是J列中,符合條件的,復(fù)制行到表1中。 Sub xx() On Error Resume Next Dim x As Long x = Sheets("newsheet").Range("a65536").End(xlUp).Row() + 1 For i = 1 To Sheet1.Range("a65536").End(xlUp).Row() If Sheet1.Cells(i, "J") = 1 Then Sheet2.Rows(i).Copy Sheet1.Select Rows(x).Select ActiveSheet.Paste x = x + 1 End If Next i End Sub 以上代碼,表2中J列的條件是:1 Sub 篩選() Dim i, n, arr, brr, a# arr = [a1].CurrentRegion a = InputBox("請輸入篩選的數(shù)字", "數(shù)字") ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2)) For i = 2 To UBound(arr) If arr(i, 10) = a Then n = n + 1 For j = 1 To UBound(arr, 2) brr(n, j) = arr(i, j) Next End If Next Sheet1.[a2].Resize(UBound(brr), UBound(brr, 2)) = brr MsgBox "OK" End Sub 以上代碼,查找表2中第十列中等于你輸入的復(fù)制到表1中 好吧,結(jié)束了才曉得,只能輸入數(shù)字,不能漢字,下面是折騰漢字,還沒測試 Sub 篩選() Dim i, n, arr, brr arr = [a1].CurrentRegion a = InputBox("請輸入篩選的關(guān)鍵詞", "關(guān)鍵詞") ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2)) For i = 2 To UBound(arr) If arr(i, 10) = a Then n = n + 1 For j = 1 To UBound(arr, 2) brr(n, j) = arr(i, j) Next End If Next Sheet1.[a2].Resize(UBound(brr), UBound(brr, 2)) = brr MsgBox "OK" End Sub |
|