Question

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

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)

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

{{1}}

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

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

2 个答案: