vba 查找并选择多行

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/482889/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-08 09:35:24  来源:igfitidea点击:

Find and select multiple rows

excelvbaexcel-vba

提问by Kim

How do I search a column for a text and select all columns and rows which match the search text ?

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

Sample table:

示例表:

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

So the marco searches for "Hyman" then it should select all of Row5-7 in ColA-D.

因此,marco 搜索“Hyman”,然后它应该选择 ColA-D 中的所有 Row5-7。

采纳答案by Kim

I ended up doing something slightly different from my question.

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

This macro will search on each row in source sheet and copy it to target sheet, which is the parameter. The data does not have to be sorted, but this makes the runtime of the marco longer. You can fix this by comparing previous row searched for a different value than before. The target sheet must exist and any data will be overwritten (not possible to undo!)

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

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

Remove each pair of // before using.

使用前删除每一对//。

回答by Phil.Wheeler

This isn't as pretty as it could be, but it gets the job done:

这并不像它想象的那么漂亮,但它完成了工作:

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("Hyman")

        // 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

PLEASE NOTE: I've replaced the VBA ' comment with a C# // comment to make this code sample more legible.

请注意:我已将 VBA ' 注释替换为 C# // 注释以使此代码示例更清晰。