在一列中查找文本并在另一列中显示

Question

我有一个包含文本的列（Screeshot中的A列），它有一些标签（文本被＆lt;＆gt;包围），我想在单元格中找到所有这些标签并将其复制到相邻的单元格（列屏幕截图中的B），基本上我想在A列中制作一个标签列表。

谢谢， 基兰

Answer 1

我已经创建了一个宏，可以完全满足您的需求。

Sub ExtractTags()
Dim ColA As Integer
Dim ColB As Integer
Dim Row As Integer
Dim Content As String
Dim Tags As String
Dim CurrentTag As String
Dim OpenTag As Integer
Dim CloseTag As Integer
Dim NumOfTags As Integer

ColA = 1 'this marks column A
ColB = 2 'this marks column B
Row = 2 'this marks the Row, which we'll increment 1 by 1 to make the code go thru each row

Do
    Content = Sheets("Sheet1").Cells(Row, ColA).Value 'extracts the content for manipulation

    If InStr(1, Content, "<", vbBinaryCompare) Then 'This checks to see if there are any tags at all. If there are, we go in
        Position = 0 'this is the starting position of the search
        NumOfTags = 0 'this helps keep track of multiple tags in a single cell

        Do
            'each time this part loops, it cuts out the first tag and all the content before it so that the code can hit the
            'first instance of "<" of the remaining content of the cell
            Position = InStr(Position + 1, Content, "<", vbBinaryCompare) 'finds the first instance of "<"
            NumOfTags = NumOfTags + 1 'since we have a tag, increment the counter by 1

            OpenTag = InStr(Position, Content, "<", vbTextCompare) 'marks the begining of the tag
            CloseTag = InStr(Position, Content, ">", vbTextCompare) - 1 'marks the end of the tag

            CurrentTag = Left(Content, CloseTag) 'cuts out the content after the tag
            CurrentTag = Right(CurrentTag, Len(CurrentTag) - OpenTag) 'cuts out the content before the tag

            If NumOfTags = 1 Then 'this part checks to see if we've already got tags
                Tags = CurrentTag 'if this is the first tag, just put it in
            Else
                Tags = Tags & ", " & CurrentTag 'if this is the second tag onwards, we add a comma to seprate the tags
            End If
        Loop Until InStr(Position + 1, Content, "<", vbBinaryCompare) = False 'this is the checker to see if there are anymore tags in the content

        Sheets("Sheet1").Cells(Row, ColB).Value = Tags 'input all the tags into column B
    End If

    Row = Row + 1 'move on to the next row
Loop Until Content = "" 'if the next row is empty, we stop
End Sub

我希望这会有所帮助。