从单元格中提取文本

我有一个searchfunction，完美的search精确的数值，但我需要适应它，所以它search单元格内的文本，只提取文本。 例如，它search第7列。在第7列可能有一个单元格包含单词接口 – HPT，SAS，LPT理想情况下，我想寻找单词接口 – HPT然后提取只有这个文本从单元格。 我也需要searchfunction，以便能够为多个不同的值做到这一点。 因此，例如运行search接口 – HPT接口 – SAS和接口LPT彼此分开。 这可能吗 ？

这是我现在的代码：

Sub InterfaceMacro() Dim Headers() As String: Headers = _ Split("Target FMECA,Part ID,Line ID,Part No.,Part Name,Failure Mode,Assumed System Effect,Assumed Engine Effect", ",") Worksheets.Add().Name = "Interface" Dim wsInt As Worksheet: Set wsInt = Sheets("Interface") wsInt.Move after:=Worksheets(Worksheets.Count) wsInt.Cells.Clear Application.ScreenUpdating = False With wsFHA For i = 0 To UBound(Headers) .Cells(2, i + 2) = Headers(i) .Columns(i + 2).EntireColumn.AutoFit Next i .Cells(1, 2) = "Interface TABLE" .Range(.Cells(1, 2), .Cells(1, UBound(Headers) + 2)).MergeCells = True .Range(.Cells(1, 2), .Cells(1, UBound(Headers) + 2)).HorizontalAlignment = xlCenter .Range(.Cells(1, 2), .Cells(2, UBound(Headers) + 2)).Font.Bold = True End With Dim SourceCell As Range, FirstAdr As String Dim RowCounter As Long: RowCounter = 3 Dim SearchTarget() As String SearchTarget = Split("9.1,18.0", ",") For i = 0 To UBound(SearchTarget) If Worksheets.Count > 1 Then For j = 1 To Worksheets.Count - 1 With Sheets(j) Set SourceCell = .Columns(7).Find(SearchTarget(i), LookAt:=xlWhole) If Not SourceCell Is Nothing Then FirstAdr = SourceCell.Address Do wsInt.Cells(RowCounter, 2).Value = SearchTarget(i) wsInt.Cells(RowCounter, 3).Value = .Cells(SourceCell.Row, 6).Value wsInt.Cells(RowCounter, 4).Value = .Cells(3, 10).Value wsInt.Cells(RowCounter, 5).Value = .Cells(2, 10).Value wsInt.Cells(RowCounter, 6).Value = .Cells(SourceCell.Row, 2).Value For k = 0 To SourceCell.Row - 1 If .Cells(SourceCell.Row - k, 3).Value <> "continued." Then wsFHA.Cells(RowCounter, 7).Value = .Cells(SourceCell.Row - k, 3).Value Exit For End If Next k wsInt.Cells(RowCounter, 8).Value = .Cells(SourceCell.Row, 14).Value Set SourceCell = .Columns(7).FindNext(SourceCell) RowCounter = RowCounter + 1 Loop While Not SourceCell Is Nothing And SourceCell.Address <> FirstAdr End If End With Next j End If Next i End Sub 

我相信这部分是需要编辑的部分

 Dim SourceCell As Range, FirstAdr As String Dim RowCounter As Long: RowCounter = 3 Dim SearchTarget() As String SearchTarget = Split("9.1,18.0", ",") For i = 0 To UBound(SearchTarget) If Worksheets.Count > 1 Then For j = 1 To Worksheets.Count - 1 With Sheets(j) Set SourceCell = .Columns(7).Find(SearchTarget(i), LookAt:=xlWhole) If Not SourceCell Is Nothing Then FirstAdr = SourceCell.Address 

Answer 1

您可以将数组定义为按照您为数字定义的方式进行search。

.Find(SearchTarget(i), LookAt:=xlWhole)为.Find(SearchTarget(i), LookAt:=xlPart)也要search部分单元格内容。

VBA查找公式/结果的方式与“查找/replace”对话框中的查找方式相同。 （设置.LookIn到xlValues或xlFormulas ）