初学者VBA脚本编写器。如何修复我的代码,以便它将通过Sheet1搜索strSearch中的字符串数组并将这些行复制到Sheet2中?
另外,如何扩展代码以便能够搜索不同的字符串数组并将其复制到另一个工作表中?
Dim ws1 As Worksheet, ws2 As Worksheet
Dim copyFrom As Range
Dim lRow As Long
Dim lastRow As Long
Dim strSearch As Variant
Dim i As Integer
Set ws1 = Worksheets("Sheet1")
With ws1
.AutoFilterMode = False
lRow = .Range("J" & .Rows.Count).End(xlUp).Row
With .Range("J1:J" & lRow)
On Error Resume Next
strSearch = Array("John","Jim")
.AutoFilter Field:=1, Criteria1:=strSearch
Set copyFrom = .Offset(0).SpecialCells(xlCellTypeVisible).EntireRow
On Error GoTo 0
End With
Set ws2 = Worksheets("Sheet2")
With ws2
On Error Resume Next
lastRow = ws2.Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row
Set Rng = copyFrom.SpecialCells(xlCellTypeConstants)
Rng.Copy .Cells(lastRow + 1, "C")
copyFrom.Delete
On Error GoTo 0
End With
.AutoFilterMode = False
答案 0 :(得分:0)
Dim strsearchlocation as integer
strSearchLocation = Sheet1.Cells.Find(what:= strSearch, After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).row
Sheet1.Rows(strSearchLocation).Copy
查找并复制strSearch行
答案 1 :(得分:0)
您可以遍历这些行和数组:
Option Explicit
Dim firstRowWs1 As Long
Dim lastRowWs1 As Long
Dim lastRowWs2 As Long
Dim searchColumnWs1 As Integer
Dim i As Integer
Dim check As Variant
Dim strSearch As Variant
Sub test()
lastRowWs1 = ws1.UsedRange.Rows.Count
lastRowWs2 = ws2.UsedRange.Rows.Count
firstRowWs1 = 2
searchColumnWs1 = 1
strSearch = Array("John", "Jim")
For i = firstRowWs1 To lastRowWs1
For Each check In strSearch
If check = ws1.Cells(i, searchColumnWs1).Value Then
ws1.Rows(i).Copy (ws2.Rows(lastRowWs2 + 1))
lastRowWs2 = lastRowWs2 + 1
ws1.Rows(i).Delete shift:=xlUp
i = i - 1
Exit For
End If
Next check
Next i
End Sub