|
▼おにこ さん:
こんにちは。
こんな感じで
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
|
|