| 
    
     |  | ▼おにこ さん: こんにちは。
 
 こんな感じで
 
 Sub TEST()
 Dim i    As Long
 Dim j    As Long
 Dim x    As Long
 Dim y    As Long
 Dim v    As Variant
 Dim v1   As Variant
 Dim S1()  As String
 Dim S2()  As String
 
 v = Range("AA1").CurrentRegion.Resize(, 1).Value
 For i = 1 To UBound(v)
 Erase S1
 Erase S2
 x = 0
 y = 0
 v1 = Split(v(i, 1), "、", , vbTextCompare)
 For j = 0 To UBound(v1)
 If InStr(1, v1(j), "<", vbTextCompare) > 0 And _
 InStr(1, v1(j), ">", vbTextCompare) > 0 Then
 ReDim Preserve S1(x)
 S1(x) = v1(j)
 x = x + 1
 Else
 ReDim Preserve S2(y)
 S2(y) = v1(j)
 y = y + 1
 End If
 Next
 Cells(i, 27).Value = Join(S2, "、")
 Cells(i, 34).Value = Join(S1, "、")
 Next
 End Sub
 
 
 |  |