Excel VBA 在列中搜索值并将行复制到新工作表以获取所有匹配值 [英] Excel VBA Search for a value in a column and copy row to new sheet for all matching values

问题描述

它应该做的是比较 G 列中的名称，在 E 列中找到该名称，如果匹配，则将所有名称复制到新工作表中.现在，代码搜索一个名为 Mail box 的值，每次在 E 列的范围内找到它时，它都会将整行复制到一个新的 sheet2 中.

What it is supposed to do is compare a name from column G, find that name in column E and if there is a match, copy all to a new sheet. Right now the code searches for a value called Mail box, each time it finds it in range of the column E it copies the whole row to a new sheet2.

我能够转换代码，而不是搜索邮箱，而是搜索单元格 G1 中的值，但我需要代码再次执行几次，以获取行 G2、G3、G4 中的值，G5...G20.

I am capable of transforming the code that instead of searching for Mail box it searches for a value in a cell G1, yet I would need the code to do it several times again for a value in row G2, G3, G4, G5...G20.

Sub SearchForString()

   Dim LSearchRow As Integer
   Dim LCopyToRow As Integer

   On Error GoTo Err_Execute

   'Start search in row 4
   LSearchRow = 4

   'Start copying data to row 2 in Sheet2 (row counter variable)
   LCopyToRow = 2

   While Len(Range("A" & CStr(LSearchRow)).Value) > 0

      'If value in column E = "Mail Box", copy entire row to Sheet2
      If Range("E" & CStr(LSearchRow)).Value = "Mail Box" Then

         'Select row in Sheet1 to copy
         Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
         Selection.Copy

         'Paste row into Sheet2 in next row
         Sheets("Sheet2").Select
         Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
         ActiveSheet.Paste

         'Move counter to next row
         LCopyToRow = LCopyToRow + 1

         'Go back to Sheet1 to continue searching
         Sheets("Sheet1").Select

      End If

      LSearchRow = LSearchRow + 1

   Wend

   'Position on cell A3
   Application.CutCopyMode = False
   Range("A3").Select

   MsgBox "All matching data has been copied."

   Exit Sub

Err_Execute:
   MsgBox "An error occurred."

End Sub

推荐答案

根据您的评论，您似乎只想查看 E 列​​中的任何单元格是否与 G 列中的任何单元格匹配，然后执行复制.您可以按如下方式实现:

Based on your comment, it seems you just want to see if any cell in column E matches any cell in Column G, and then perform your copying. You can achieve this as follows:

  'If value in column E = Matches anything in column G, copy entire row to Sheet2
  Dim searchTerm As String
  For i = 1 To 20
      searchTerm = Range("G" & i).Text
      If Range("E" & CStr(LSearchRow)).Value = searchTerm Then

         'Select row in Sheet1 to copy
         Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
         Selection.Copy

         'Paste row into Sheet2 in next row
         Sheets("Sheet2").Select
         Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
         ActiveSheet.Paste

         'Move counter to next row
         LCopyToRow = LCopyToRow + 1

         'Go back to Sheet1 to continue searching
         Sheets("Sheet1").Select

      End If
Next i

这只是通过 G1:G20 循环，在那里获取 G 的每个值，并且对于 E 的每一行(与您的 While 循环一样)，它检查 G 的每个值，然后执行复制.

This simply loops through G1:G20, picks up each value of G there, and for each row of E (as looped with your While loop), it checks for each value of G and then performs the copying.

这篇关于Excel VBA 在列中搜索值并将行复制到新工作表以获取所有匹配值的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！