(VBA) 複数スペースで文字列を分割する

質問

文字列中の文字を
複数の半角スペースで分割するコードを教えて下さい。
　　（半角スペースの数は、2個以上一定ではありません。）

但し、文字列中には複数スペース群が複数回ある場合がありますが
　分割は、最初の複数スペース群とします。

例えば、

「SetOne_Vol xn xo サンプル」
の場合は、
「SetOne_Vol」と「xn xo サンプル」に分割
（分割した最初のスペース群の次にあるスペース群は何も変更なく
　　同数のスペースを書き出します。）

但しセミコロン「；」やコロン「：」で始まる
文字列は対象外でそのまま分割せずに書き出します。

添付画像を参照ください。

　　A: 元の文字列
B: 分割文字列（左側）
C: 分割文字列（右側）

----------------------------------
Office＿2019　/　Windows10

回答No.4

kkkkkm · ベストアンサー

> エクセルの行に何も文字列が無い改行だけのセルが複数存在しています

以下で試してみて下ささい。

Sub Test()
Dim i As Long
Dim Temp As Variant
Dim mStr As String

For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
mStr = WorksheetFunction.Trim(Replace(Cells(i, "A").Value, vbLf, ""))
Select Case Left(mStr, 1)
Case ";", ":", ""
Cells(i, "B").Value = Cells(i, "A").Value
Case Else
Temp = Split(mStr, " ")
Cells(i, "B").Value = Temp(0)
If LBound(Temp) <> UBound(Temp) Then
Cells(i, "C").Value = Mid(Cells(i, "A").Value, InStr(Cells(i, "A").Value, Temp(1)))
End If
End Select
Next

End Sub

お礼

No.4のコードで改行だけのセルも上手く処理できました。

少し、本物のDATAで試用運転してみます。

回答No.3

kkkkkm

Case ";", ":"
の後の
Cells(i, "B").Value = Cells(i, "A").Value

が抜けてました。

補足

NO2,No3を受けてコードを修正しましたが、
同じエラーが以下のコードで出ます。
Cells(i, "B").Value = Temp(0)

’以下修正済みコード---------------------
Option Explicit

Sub Test()
Dim i As Long
Dim Temp As Variant

For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
Select Case Left(Cells(i, "A").Value, 1)
Case ";", ":"
Cells(i, "B").Value = Cells(i, "A").Value
Case Else
Temp = Split(WorksheetFunction.Trim(Cells(i, "A").Value), " ")
Cells(i, "B").Value = Temp(0)
Cells(i, "C").Value = Mid(Cells(i, "A").Value, InStr(Cells(i, "A").Value, Temp(1)))
End Select
Next
End Sub

回答No.2

kkkkkm

失礼No1は間違えましたm(__)m

Sub Test()
Dim i As Long
Dim Temp As Variant

For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
Select Case Left(Cells(i, "A").Value, 1)
Case ";", ":"
Case Else
Temp = Split(WorksheetFunction.Trim(Cells(i, "A").Value), " ")
Cells(i, "B").Value = Temp(0)
Cells(i, "C").Value = Mid(Cells(i, "A").Value, InStr(Cells(i, "A").Value, Temp(1)))
End Select
Next
End Sub

回答No.1

kkkkkm

以下で試してみてください。

Sub Test()
Dim i As Long
Dim Temp As Variant

For i = 2 To Cells(Rows.Count, "A").Row
Select Case Left(Cells(i, "A").Value, 1)
Case ";", ":"
Exit For
End Select
Temp = Split(WorksheetFunction.Trim(Cells(i, "A").Value), " ")
Cells(i, "B").Value = Temp(0)
Cells(i, "C").Value = Mid(Cells(i, "A").Value, InStr(Cells(i, "A").Value, Temp(1)))
Next

End Sub

お礼

kkkkkmさん、今回も回答感謝します。

以下の行で「インデックスが有効範囲にありません」(実行時エラー　９)がでました。
Cells(i, "C").Value = Mid(Cells(i, "A").Value, InStr(Cells(i, "A").Value, Temp(1)))

多分、私の質問文で記載不足がある為と思われます。
（エクセルの行に何も文字列が無い改行だけのセルが複数存在しています。）

なので以下のように改行だけにセルを判別しようとしましたが
今度は、以下で同じく改行だけのセルで同じエラーが出ます。
Cells(i, "B").Value = Temp(0)

Sub Test()
Dim i As Long
Dim Temp As Variant
Dim sCR As String
Dim sLF As String
Dim sCRLF As String

sCR = vbCr
sLF = vbLf
sCRLF = vbCrLf

For i = 2 To Cells(Rows.Count, "A").Row
Select Case Left(Cells(i, "A").Value, 1)
Case ";", ":", sCR, sLF, sCRLF
Exit For
End Select
Temp = Split(WorksheetFunction.Trim(Cells(i, "A").Value), " ")
Cells(i, "B").Value = Temp(0)
Cells(i, "C").Value = Mid(Cells(i, "A").Value, InStr(Cells(i, "A").Value, Temp(1)))
Next

End Sub