问题描述
如何搜索文本列,并选择与搜索文本相匹配的所有列和行?
How do I search a column for a text and select all columns and rows which match the search text ?
示例表:
ColA ColB ColC ColD
Row1 Bob
Row2 Jane
Row3 Joe
Row4 Joe
Row5 Jack
Row6 Jack
Row7 Jack
Row8 Peter
Row9 Susan
所以马可搜索杰克,那么它应该选择ColA-D中的所有Row5-7。
So the marco searches for "Jack" then it should select all of Row5-7 in ColA-D.
推荐答案
我最终做了一些与我的问题略有不同的事情。
I ended up doing something slightly different from my question.
此宏将在源表中的每一行进行搜索,并将其复制到目标表,这是参数。
数据不一定要排序,但这使得marco的运行时间更长。您可以通过比较先前搜索的值与以前不同的值来修复此问题。
目标表必须存在,任何数据都将被覆盖(不可撤销!)
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.
这篇关于查找并选择多行的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!