VBA查找字符串并返回所有结果的行号

Question

我正在寻找一个代码来从单元格中提取所有品牌名称，文本结构类似于下面的文字：

….Brandname>Nekteck</span….
….Brandname>Dell</span….
….Brandname>Apple</span….

我使用Find属性查找文本“Brandname>”来查找行号并使用InStr属性来提取品牌名称 - 代码如下。但是，我需要找到所有品牌名称，而不仅仅是找到的第一个品牌名称。任何建议表示赞赏。

Dim str As String
Dim openPos As Long
Dim closePos As Long
Dim Brand As String

Sheets("Workingsheet").Activate
Cells.Find(What:="Brandname>", After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Row = Brand1
str = Cells(Brand1, 2).Text
openPos = InStr(str, "Brandname>") + 10
closePos = InStr(str, "</span") - 7
Brand = Mid(str, openPos, closePos - openPos)

Answer 1

我会添加一个像这样的循环来查找所有匹配项：

With ActiveSheet.UsedRange

Set BrandName = .Cells.Find(What:="Brandname>")

If Not BrandName Is Nothing Then
 Do Until BrandName Is Nothing

  'add here you code (what you what to do when it finds it)

  Set BrandName = .FindNext(BrandName)
 Loop
End If

End With

Answer 2

如果你想只留下带有品牌名称的单元格，后者在A栏中：

Sub LeaveBrands()
    With Intersect(Range("A:A"), ActiveSheet.UsedRange)
        .Replace "*Brandname>", "", lookat:=xlPart
        .Replace "</span*", "", lookat:=xlPart
    End With
End Sub

否则，如果你不介意覆盖单元格内容，后者在A列中：

Sub ListBrands()
    Dim cell As Range

    With Intersect(Range("A:A"), ActiveSheet.UsedRange)
        .Replace "*Brandname>", "", lookat:=xlPart
        .Replace "</span*", "", lookat:=xlPart
        For Each cell In .SpecialCells(xlCellTypeConstants, xlTextValues)
            MsgBox cell.Value2
        Next
    End With
End Sub