首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >查找并选择多行

查找并选择多行
EN

Stack Overflow用户
提问于 2009-01-27 10:25:47
回答 2查看 65.2K关注 0票数 4

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

示例表:

代码语言:javascript
复制
      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中的所有第5-7行。

EN

回答 2

Stack Overflow用户

回答已采纳

发布于 2009-01-28 09:34:26

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

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

代码语言:javascript
复制
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

在使用之前,请移除每对//。

票数 4
EN

Stack Overflow用户

发布于 2009-01-27 21:44:39

这并不像它可能的那样漂亮,但它完成了工作:

代码语言:javascript
复制
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的注释,以使此代码示例更易读。

票数 0
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/482889

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档