查找并选择多行

时间:2009-01-27 10:25:47

标签: excel vba excel-vba

如何在列中搜索文本并选择与搜索文本匹配的所有列和行?

样本表:

      ColA  ColB  ColC  ColD
Row1        Bob
Row2        Jane
Row3        Joe
Row4        Joe
Row5        Jack
Row6        Jack
Row7        Jack
Row8        Peter
Row9        Susan

所以marco搜索“Jack”然后它应该选择ColA-D中的所有Row5-7。

2 个答案:

答案 0 :(得分:4)

我最终做了一些与我的问题略有不同的事情。

此宏将搜索源表中的每一行并将其复制到目标表,即参数。 数据不必排序,但这会使marco的运行时更长。您可以通过比较搜索不同值的上一行来解决此问题。 目标表必须存在,任何数据都将被覆盖(无法撤消!)

Sub Search_SelectAndCopy(sheetname As String)

Dim SheetData As String
Dim DataRowNum As Integer, SheetRowNum As Integer

SheetData = "name of sheet to search in" //' Source sheet
DataRowNum = 2 //' Begin search at row 2
SheetRowNum = 2 //' Begin saving data to row 2 in "sheetname"

//' Select sheetname, as its apparently required before copying is allowed !
Worksheets(SheetData).Select

//' Search and copy the data
While Not IsEmpty(Cells(DataRowNum, 2)) //' Loop until column B gets blank
    //' Search in column B for our value, which is the same as the target sheet name "sheetname"
    If Range("B" & CStr(DataRowNum)).Value = sheetname Then
       //' Select entire row
       Rows(CStr(DataRowNum) & ":" & CStr(DataRowNum)).Select
       Selection.Copy

       //' Select target sheet to store the data "sheetname" and paste to next row
       Sheets(sheetname).Select
       Rows(CStr(SheetRowNum) & ":" & CStr(SheetRowNum)).Select
       ActiveSheet.Paste

       SheetRowNum = SheetRowNum + 1 //' Move to next row

       //' Select source sheet "SheetData" so searching can continue
       Sheets(SheetData).Select
   End If

   DataRowNum = DataRowNum + 1 //' Search next row
Wend

//' Search and copying complete. Lets make the columns neat
Sheets(sheetname).Columns.AutoFit

//' Finish off with freezing the top row
Sheets(sheetname).Select
Range("A2").Select
ActiveWindow.FreezePanes = True
End Sub

在使用前删除每对//。

答案 1 :(得分:0)

这并不尽如人意,但它完成了工作:

Public Sub SelectMultiple()
    Dim wbkthis As Workbook
    Dim shtthis As Worksheet
    Dim rngThis As Range
    Dim rngFind As Range
    Dim firstAddress As String
    Dim addSelection As String


    Set wbkthis = ThisWorkbook
    Set shtthis = wbkthis.Worksheets("Sheet1")

    // Set our range to search
    Set rngThis = shtthis.Range("B2", "B10")

    // Loop through it
    With rngThis

        // Find our required text
        Set rngFind = .Find("Jack")

        // If we find it then...
        If Not rngFind Is Nothing Then
            firstAddress = rngFind.Address // Take a note of where we first found it
            addSelection = addSelection & rngFind.Address & "," // Add the cell's range to our selection

            // Loop through the rest of our range and find any other instances.
            Do
                Set rngFind = .FindNext(rngFind)
                addSelection = addSelection & rngFind.Address & ","
            Loop While Not rngFind Is Nothing And rngFind.Address <> firstAddress

        End If
    End With

    // Trim the last comma from our string
    addSelection = Mid(addSelection, 1, Len(addSelection) - 1)
    shtthis.Range(addSelection).Rows.Select // Select our rows!

    Set rngThis = Nothing
    Set shtthis = Nothing
    Set wbkthis = Nothing

End Sub

请注意:我已用C#//评论替换了VBA的评论,以使此代码示例更清晰。