Question

我想要实现的是在同一列Excel工作表（Sheet1）的B列中搜索G列中的文本列表，如果发生匹配，则必须复制整行并将其粘贴到另一张工作表中（Sheet2））。实际上，我已经尝试了很多调试代码，但无法正常工作。任何帮助将不胜感激！我已经附上了下面的代码。

谢谢阿努伊

Sub SearchForString()

   Dim LSearchRow As Integer
   Dim LCopyToRow As Integer
   Dim searchTerm As String

   On Error GoTo Err_Execute


   LSearchRow = 2
   LCopyToRow = 2


  For i = 2 To 15
      searchTerm = Range("G" & i).Text
      If Range("B" & CStr(LSearchRow)).Value = searchTerm Then


         Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
         Selection.Copy


         Sheets("Sheet2").Select
         Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
         ActiveSheet.Paste


         LCopyToRow = LCopyToRow + 1


         Sheets("Sheet1").Select

      End If

Next i

LSearchRow = LSearchRow + 1

   Application.CutCopyMode = False
   Range("A3").Select

   MsgBox "All matching data has been copied!"

   Exit Sub

Err_Execute:
   MsgBox "An error occurred!"

End Sub

Answer 1

Public Sub HereComesTheCode()

    Dim copyToRow As Long: copyToRow = 2
    Dim wks1 As Worksheet: Set wks1 = Worksheets(1)
    Dim wks2 As Worksheet: Set wks2 = Worksheets(2)
    Dim i As Long

    For i = 2 To 15            
        If wks1.Cells(i, "B") = wks1.Cells(i, "G") And wks1.Cells(i, "B") <> "" Then

            wks1.Range(wks1.Cells(i, "B"), wks1.Cells(i, "G")).Copy
            wks2.Cells(copyToRow, "B").PasteSpecial xlPasteAll
            copyToRow = copyToRow + 1
            Application.CutCopyMode = False                
        End If                
    Next i 

End Sub

将变量声明为Long，而不是Integer;
How to avoid using Select in Excel VBA
声明较少的变量，您不需要全部；

Answer 2

我认为匹配值不必位于同一行。

For i = 2 To Range("G" & Rows.Count).End(xlUp).Row
  searchTerm = Range("G" & i).Text
  For LSearchRow = 1 To Range("B" & Rows.Count).End(xlUp).Row
  If Range("B" & CStr(LSearchRow)).Value = searchTerm Then
     Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Copy
     Sheets("Sheet2").Select
     Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
     ActiveSheet.Paste
     LCopyToRow = LCopyToRow + 1
     Sheets("Sheet1").Select
  End If
  Next LSearchRow
Next i

在Excel中将匹配的行复制到两列中

2 个答案: