Excel搜索和返回

Question

我想搜索一個具有名稱列表的Excel文件。所有的名字都是隨機排列的。我希望能夠搜索諸如「Tom」之類的字符串，並返回所有帶有附加數據的「Tom」字符串。因此，如果有500個名稱的列表，並且只有15個條目，我希望該公式將所有15個條目都拉出並輸出到電子表格的另一個區域。此外，是否可以這樣做，然後返回與「Tom」關聯的所有列以完成整個行條目？提前致謝。

Answer 1

您可以使用ADO：

Dim cn As Object 
Dim rs As Object 
Dim strFile As String 
Dim strCon As String 
Dim strSQL As String 
Dim s As String 
Dim i As Integer, j As Integer 

''This is not the best way to refer to the workbook 
''you want, but it is very convenient for notes 
''It is probably best to use the name of the workbook. 

strFile = ActiveWorkbook.FullName 

''Note that if HDR=No, F1,F2 etc are used for column names, 
''if HDR=Yes, the names in the first row of the range 
''can be used. 
''This is the Jet 4 connection string, you can get more 
''here : http://www.connectionstrings.com/excel 

strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _ 
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";" 

''Late binding, so no reference is needed 

Set cn = CreateObject("ADODB.Connection") 
Set rs = CreateObject("ADODB.Recordset") 


cn.Open strCon 

strSQL = "SELECT * " _ 
     & "FROM [Sheet1$] " _ 
     & "WHERE MyField ='Tom' " 

rs.Open strSQL, cn, 3, 3 

''You can iterate through the fields here if you want headers 
''Pick a suitable empty worksheet for the results 

Worksheets("Sheet3").Cells(2, 1).CopyFromRecordset rs 

''Tidy up 
rs.Close 
Set rs=Nothing 
cn.Close 
Set cn=Nothing 

Answer 2

要查看這些數據，你可以只應用一個過濾器中的數據，並從名稱列中選擇名稱。不需要以這種方式複製數據。

得到數據的拷貝，複製粘貼，爲正常（隱藏的行不會被複制）

實現自動化，寫Sub重複這些步驟。

Answer 3

這是一個簡單的宏，用於顯示輸入框，並過濾並複製與輸入到新工作表中的值相匹配的數據。

Public Sub sortAndCopy() 
Dim rngFilterRange As Range 
Dim strSearchString As String 
Dim wsTargetSheet As Worksheet 

'change this to refer to the sheet that contains the data 
Set rngFilterRange = ThisWorkbook.Sheets("Data").UsedRange 

'prompt for string to filter by 
strSearchString = Application.InputBox("Enter value to search for") 

With rngFilterRange 
'filter data range - assumes data is in column 1, but change the field if necessary 
    .AutoFilter Field:=1, Criteria1:=strSearchString 
'creates a new sheet and copies the filtered data - 
'change this to refer to the range you require the data to be copied to 
    .Copy Destination:=ThisWorkbook.Sheets.Add.Range("A1") 
'turn off filters 
    .Parent.ShowAllData 
    .Parent.AutoFilterMode = False 
End With 

End Sub