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
Find and select multiple rows
提问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# // 注释以使此代码示例更清晰。

