Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/24.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel搜索和返回_Excel_Vba - Fatal编程技术网

Excel搜索和返回

Excel搜索和返回,excel,vba,Excel,Vba,我想搜索包含名称列表的excel文件。所有的名字都是随机排列的。我希望能够搜索像“Tom”这样的字符串,作为回报,得到所有带有附加数据的“Tom”字符串。因此,如果有一个500个名字的列表,而Tom只有15个条目,我希望公式将所有15个条目都拉出来,并将它们输出到电子表格的另一个区域。另外,是否可以这样做,然后返回与“Tom”关联的所有列以完成整个行条目?提前感谢。您可以使用ADO: Dim cn As Object Dim rs As Object Dim strFile As String

我想搜索包含名称列表的excel文件。所有的名字都是随机排列的。我希望能够搜索像“Tom”这样的字符串,作为回报,得到所有带有附加数据的“Tom”字符串。因此,如果有一个500个名字的列表,而Tom只有15个条目,我希望公式将所有15个条目都拉出来,并将它们输出到电子表格的另一个区域。另外,是否可以这样做,然后返回与“Tom”关联的所有列以完成整个行条目?提前感谢。

您可以使用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

要查看此数据,您可以对数据应用筛选器,然后从“名称”列中选择名称。不需要以这种方式复制数据

要获取数据的副本,请按常规复制粘贴(隐藏行不会被复制)


要实现自动化,请编写一个子代码来重复这些步骤。

下面是一个简单的宏,用于显示输入框,过滤并复制与输入值匹配的数据到新工作表上

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