excel - ある列のテキストを検索して別の列に表示する

Question

テキストを含む列 (スクリーンショットの列 A) があり、いくつかのタグ (< > で囲まれたテキスト) があります。セル内のこれらすべてのタグを見つけて、隣接するセル (スクリーンショットの列 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

これが役立つことを願っています。