VBA基于字符串数组将行排序到不同的工作表中

时间:2017-10-25 13:40:40

标签: vba excel-vba excel

初学者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

2 个答案:

答案 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