拡張Split関数の出力をセルに

質問

以下をネットでみつけました。

https://vbabeginner.net/multiple-split/

Splitの拡張関数で区切り文字を複数指定できるので便利だと思いました。

記事では、結果を「Debug.Print」でイミディエイトウィンドウに出力していますが
関数なのでエキセルのシートのセルにも出力させる事ができると思うのですが
どうやったら良いですか？

記事のようなSUB(SpritExTest())を作成すれば良いのでしょうが
関数なので汎用で利用できないかと考えました。

例えば、シートで
A1:　AAAA/BBBB*CCCC/DDDD*EEEE　だとして
B1:SplitEx(A1,Array"/","*"))と入力すれば

例えば以下のように右側に表示される
C1:AAAA
D1:BBBB
E1:DDDD
F1:EEEE

これができれば、B1の式を下方向にコピペすると
C、D,E,F列に
A列の同じようなセルがあれば連続して分割処理（出力）される

回答No.31

kkkkkm · ベストアンサー

> 　　0:5:23 と　希望する 0:05:23 になっていませんでした。

上の方にある
mStr(k) = "0:" & Temp(j)
を
mStr(k) = Format("0:" & Temp(j), "hh:mm:ss")
に変更していないせいだと思います。

> 区切り文字に「.」と「__」(アンダーバー２個)分離されていません。

追加時には時間部分のみを分割したいという要望でした。
別途分割対象にできないかとありましたし、時間部分を分割したいデータと区切り文字指定が有効なデータは別であると考えていました。
同じ関数と引数でデータによって動作を切り分けたいという感じです。

全て同時にやりたいのでしたら以下のコードで
Function 区切りチェック(区切りチェック用) As Boolean
は変更がないので記載しません途切れる可能性がありそうなので。
区切り文字
".","__","/",":"
で
CD1-12__One Of These Days /6:32
は
CD1-12|One Of These Days|00:06:32
になります。

Function SplitEx6(元の文字列, ParamArray 区切り文字() As Variant) As Variant
Dim v As Variant '// 配列要素
Dim i As Integer '// ループカウンタ
Dim s As String '// 引数文字列
Dim sFirst As String '// 配列先頭要素の区切り文字
Dim 区切りチェック用: 区切りチェック用 = IIf(IsArray(区切り文字(0)), 区切り文字(0), 区切り文字)
' '// 文字列型ではない場合
If TypeName(元の文字列) <> "String" And TypeName(元の文字列) <> "Range" Then
GoTo ERROR_EXIT
End If
'// 引数文字列をコピー
s = 元の文字列
'// 引数文字列が未設定の場合
If s = "" Then
GoTo ERROR_EXIT
End If
'// ループカウンタを初期化
i = 0
'// 区切り文字配列をループ
For Each v In 区切り文字 '(0)
'// 文字列型ではない場合
If TypeName(v) <> "String" Then
GoTo ERROR_EXIT
End If
'// ループ初回時
If i = 0 Then
'// 初回区切り文字を保持
sFirst = v
End If
'// 引数文字列の区切り文字を初回区切り文字に置き換え
s = Replace(s, v, sFirst)
'// ループカウンタを加算
i = i + 1
Next
'// 区切り文字が未設定の場合
If sFirst = "" Then
GoTo ERROR_EXIT
End If

Dim j As Long, k As Long: k = 0
Dim Temp As Variant, mStrNT As Variant, mStrT() As Variant, mStr() As Variant
ReDim mStrT(1)
mStrT(1) = ""
If 区切りチェック(区切りチェック用) = True And InStr(元の文字列, ":") > 0 Then
Temp = Split(元の文字列, " ")
k = 1
For j = LBound(Temp) To UBound(Temp)
If InStr(Temp(j), ":") > 0 Then
Temp(j) = Replace(Temp(j), "/", "")
ReDim Preserve mStrT(k)
If Len(Temp(j)) - Len(Replace(Temp(j), ":", "")) = 1 Then
mStrT(k) = Format("0:" & Temp(j), "hh:mm:ss")
Else
mStrT(k) = Temp(j)
End If
k = k + 1
Else
mStrNT = mStrNT & Temp(j) & " "
End If
Next
s = Trim(mStrNT)
i = 0
'// 区切り文字配列をループ
For Each v In 区切り文字
If v <> " " Then
If i = 0 Then
'// 初回区切り文字を保持
sFirst = v
End If
'// 引数文字列の区切り文字を初回区切り文字に置き換え
s = Replace(s, v, sFirst)
i = i + 1
End If
Next
End If
k = 0
Temp = Split(Trim(s), sFirst)
For j = LBound(Temp) To UBound(Temp)
If Temp(j) <> "" Then
ReDim Preserve mStr(k)
mStr(k) = Trim(Temp(j))
k = k + 1
End If
Next
If mStrT(1) <> "" Then
k = 1
For i = UBound(mStr) + 1 To UBound(mStr) + UBound(mStrT)
ReDim Preserve mStr(UBound(mStr) + k)
mStr(i) = mStrT(k)
k = k + 1
Next
End If
'指定区切り文字が文字列にない場合に余計に表示される時は以下を有効に
'最後にダミーを付加して解消、ただし右に1セル余計に利用される
' If UBound(mStr) = 0 Then
' ReDim Preserve mStr(1)
' mStr(1) = ""
' End If

'// 置換
SplitEx6 = mStr
Exit Function

ERROR_EXIT:
'// 戻り値をなしにする
SplitEx6 = "??"
End Function

回答No.35

kkkkkm

「Temp」「mStrT」及び「mStr」に入れる部分では

「Temp」にある「""」データを抜いて「mStrT」及び「mStr」に入れてます。

お礼

仕様を取り違える曖昧な記載内容で思っている事を伝えられずに
誤解を与える事になり解決まで時間が掛かった事お詫び申し上げます。

NO31でようやく考えていた事に相違があるのが理解できました。

NO31の修正されたコードを利用して
何種類か想定されそうなパターンで試してみました。

思っていた結果が出力されてとても満足しています。

（時間部分が複数あるケースは、無いと思いますが
　　レアケースで無いとは断言できないので有る前提でのコードは大歓迎です。）

以下の仕様は、問題ないです。

　時間区切りを有効にする場合（区切り文字に「:」がある場合）、
　区切り指定文字に「　」（スペース）が存在していても
　指定は無視されてターゲットの文字列中はスペースで分割されない。
　（区切り指定文字に「　」（スペース）が無い場合と同じ）

'---------------------------------------
新スレへのスイッチする件を了承いただき有難うございます。

もう少し、実際で使用してみて
現在の仕様に満足できない事項が出た場合は改めて相談させていただきたいと思います。

長々とお付き合い願いお疲れ様でした。
協力有難うございます。

回答No.34

kkkkkm

> ここでスレは閉じて新規に別スレで続けたいと思いますがどうでしょうか？

はい、それでいいです。

最後に、簡単な説明をしておきます。

If 区切りチェック(区切りチェック用) = True And InStr(元の文字列, ":") > 0 Then

End If

で時間部分と時間部分以外を切り離しています。
「" "」で分割した配列「Temp」を
時間部分だと時間部分の配列「mStrT」に配列を追加して入れていきます。
時間部分以外だと後ろに「" "」を追加して変数「mStrNT」の後ろに足していきます。
終わったら
「mStrNT」を変数「s」に入れてます。
区切り文字の「sFirst」に「" "」がセットされている可能性があるので再度「sFirst」を「" "」抜きでセット

End If以降
その後
時間部分を抜いたデータで分割を実行した配列「Temp」を配列「mStr」に入れていきます。
配列「mStr」の後ろに配列「mStrT」(時間部分の配列)データを配列「mStr」に配列を追加して入れていきます。

配列「mStr」を結果として出力します。

回答No.33

kkkkkm

No.31の訂正です。
時間データが複数ある場合のことを全然考えてなかったのでテストしてませんでした。
時間データが複数ある場合、後ろに余分にデータを出してましたので

最後の方にある

If mStrT(1) <> "" Then
k = 1
For i = UBound(mStr) + 1 To UBound(mStr) + UBound(mStrT)
ReDim Preserve mStr(UBound(mStr) + k)
mStr(i) = mStrT(k)
k = k + 1
Next
End If

の中の

ReDim Preserve mStr(UBound(mStr) + k)
を
ReDim Preserve mStr(UBound(mStr) + 1)
に訂正してください。

回答No.32

kkkkkm

No.31の補足です。

時間区切りが有効な場合(区切り指定文字に「:」文字列に「:」がある場合)、区切り指定文字に「" "」が存在しても「" "」は無視され「" "」の部分では分割されません。

回答No.30

kkkkkm

> どの番号が想定外なのか指摘いただけますか　？

No.19のお礼のコードと比べてみたらわかると思いますが、比べてみました？
最後の方が違いますよね。
置換のところ
No.28に説明を読めばそんなところに時間関連の操作は入らないと分かると思います。

お礼

スレが長く続いてその後のゴタゴタも有り私も混乱状態です。

昨日、思わぬ所でPCが再起動して
再起動後、EXCELを立ち上げると自動回復機能で「PERSONAL＿XLSB」に回復ファイルが作成され
２つのユーザー定義関数「SplitExwT」が出現してしまいました。
（自動回復の方の関数は、うまくいかない現状も有り
　　　イライラが高じてフォルダー毎削除しました。）

本日少し冷静になり見直し作業を開始しました。
　（現在のコードがどこまで修正されていたのか怪しい状態ですが。。。。）

No.30で
530 msr(k)="0:" & Temp(j)
は必要ないとアドバイスされていると受け取りました。

　私が、 msr(k)="0:" & Temp(j)を530の位置に入れたのは
　kkkkkmさんのNo.24の以下のアドバイスを間違って解釈したせいだと思います。
mStr(k) = Format("0:" & Temp(j), "hh:mm:ss")
は
mStr(k) = "0:" & Temp(j)
を変更です。

530 msr(k)="0:" & Temp(j) を除いて(コメントアウト)してから
試してみると以下のように
区切り文字に「.」と「__」(アンダーバー２個)分離されていません。
時間部分は、ワンピースになっていますが
　　0:5:23 と　希望する 0:05:23 になっていませんでした。

=PERSONAL.XLSB!SplitExwT(A1,".","__","/",":")

|[A] |[B] |[C]
[1]|no1. CD1-8__Wish You Were Here 5:18|no1. CD1-8__Wish You Were Here|0:5:18
[2]|CD1-2__Rattle That Lock 5:23 |CD1-2__Rattle That Lock |0:5:23
[3]|CD1-10__In Any Tongue 0:07:47 |CD1-10__In Any Tongue |0:07:47
[4]|CD1-12__One Of These Days /6:32 |CD1-12__One Of These Days |0:6:32
[5]|CD2-2__Fat Old Sun /0:06:05 |CD2-2__Fat Old Sun |0:06:05

’－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
kkkkkmさんも長すぎる質問にうんざり状態と推察致します。

時間部分に切り出しを持ち出す前までのコードで十分だったのに
付加的な時間部分の切り出してから話が噛み合わずに現在に至りました。

ここでスレは閉じて新規に別スレで続けたいと思いますがどうでしょうか？

もちろん、このままこのスレを継続する事もできます。

回答No.29

kkkkkm

No.19のお礼で時間の表示がおかしいというのでNo.22で訂正をお願いしたのは
No.19のお礼のコードです

mStr(k) = "00:" & Temp(j)
は一カ所しかありません。

補足

参考　：
比較ができるように番号付きのコードを下記に書き出しました。

どの番号が想定外なのか指摘いただけますか　？

Option Explicit

'
Function SplitExwT(元の文字列, ParamArray 区切り文字() As Variant) As Variant
Dim v As Variant '// 配列要素
Dim i As Integer '// ループカウンタ
Dim s As String '// 引数文字列
Dim sFirst As String '// 配列先頭要素の区切り文字
10 Dim 区切りチェック用: 区切りチェック用 = IIf(IsArray(区切り文字(0)), 区切り文字(0), 区切り文字)

20 If TypeName(元の文字列) <> "String" And TypeName(元の文字列) <> "Range" Then
30 GoTo ERROR_EXIT
40 End If

'// 引数文字列をコピー
50 s = 元の文字列

'// 引数文字列が未設定の場合
60 If s = "" Then
70 GoTo ERROR_EXIT
80 End If

'// ループカウンタを初期化
90 i = 0

'Dim flg As Boolean: flg = False

'// 区切り文字配列をループ
100 For Each v In 区切り文字
'// 文字列型ではない場合
110 If TypeName(v) <> "String" Then
120 GoTo ERROR_EXIT
130 End If

'// ループ初回時
140 If i = 0 Then
'// 初回区切り文字を保持
150 sFirst = v
160 End If

'If v = ":" Then
' flg = True
'End If

'// 引数文字列の区切り文字を初回区切り文字に置き換え
170 s = Replace(s, v, sFirst)

'// ループカウンタを加算
180 i = i + 1
190 Next

'// 区切り文字が未設定の場合
200 If sFirst = "" Then
210 GoTo ERROR_EXIT
220 End If

'変更、追加 (SplitExwT)
230 Dim j As Long, k As Long: k = 0
Dim Temp As Variant, mStrNT As Variant, mStr() As Variant

'If flg = True Then
'区切り文字「:」があり、かつ元の文字列に「:」がある場合に限ってとして

240 If 区切りチェック(区切りチェック用) = True And InStr(元の文字列, ":") > 0 Then

250 Temp = Split(元の文字列, " ")

260 k = 1

270 For j = LBound(Temp) To UBound(Temp)
280 If InStr(Temp(j), ":") > 0 Then
290 Temp(j) = Replace(Temp(j), "/", "")
300 ReDim Preserve mStr(k)
310 If Len(Temp(j)) - Len(Replace(Temp(j), ":", "")) = 1 Then
320 mStr(k) = "0:" & Temp(j)
330 Else
340 mStr(k) = Temp(j)
350 End If
360 k = k + 1
370 Else
380 mStrNT = mStrNT & Temp(j) & " "
390 End If
400 Next

410 mStr(0) = Trim(mStrNT)
420 SplitExwT = mStr
430 Exit Function

440 End If

450 Temp = Split(s, sFirst)
460 For j = LBound(Temp) To UBound(Temp)
470 If Temp(j) <> "" Then
480 ReDim Preserve mStr(k)
490 mStr(k) = Temp(j)
500 k = k + 1
510 End If
520 Next

'// 置換
530 mStr(k) = "0:" & Temp(j)
540 SplitExwT = mStr
550 Exit Function

ERROR_EXIT:
'// 戻り値をなしにする
560 SplitExwT = "??"
End Function

Function 区切りチェック(区切りチェック用) As Boolean
Dim v As Variant

For Each v In 区切りチェック用
If v = ":" Then
区切りチェック = True
Exit Function
End If
Next
End Function

Function 区切りチェック(区切りチェック用) As Boolean
Dim v As Variant

10 For Each v In 区切りチェック用
20 If v = ":" Then
30 区切りチェック = True
40 Exit Function
50 End If
60 Next
End Function

回答No.28

kkkkkm

If 区切りチェック(区切りチェック用) = True And InStr(元の文字列, ":") > 0 Then
から
最初の
Exit Function
End If
時間文字列を分ける指定(IF文で指定)があれば時間文字列と普通の文字列を分けて、時間文字列の配列の一番最初mStr(0)に普通の文字列を入れて出力してここで終わりです。mStr(k)のkが1から始まっているのは一番最初の0を開けておくためです。

それ以降(時間文字列を分ける指定がない場合)は時間文字列に関知せず区切り文字列で単に分割しています。

回答No.27

kkkkkm

回答No.24で訂正している箇所を確認してください。
訂正箇所が違います。

補足

>回答No.24で訂正している箇所を確認してください。
>訂正箇所が違います。

完全に手詰まりの状況です。

ご指摘の点ですが、
------------------------------------
No.24は、以下の箇所です。

mStr(k) = Format("0:" & Temp(j), "hh:mm:ss")
は
mStr(k) = "0:" & Temp(j)
を変更です。

------------------------------------

現在の私のコードで「mStr(k)」が出現する箇所は以下です。
（最初の番号は、行番号相当です。）

82 ReDim Preserve mStr(k)
84 mStr(k) = "0:" & Temp(j)
86 mStr(k) = Temp(j)
104 ReDim Preserve mStr(k)
105 mStr(k) = Temp(j)
112 mStr(k) = "0:" & Temp(j)

修正したのは、以下です。
112 mStr(k) = "0:" & Temp(j)

82,84,86,104,105　は修正すべき事項に当てはまらないと思いますが？
（ 「Format」で単語を検索してもコード内ではヒットしませんでした。）

とすれば、
kkkkkmさん対象とするコードと私が見ているコードがどこか間違っている可能性があります。

回答No.26

kkkkkm

No24の訂正がされてません。

お礼

>No24の訂正がされてません。

すいません。
やはり、凡ミスでした。

コピペする時にダブってしまいました。
mStr(k) = mStr(k) = "0:" & Temp(j)

以下のように修正しました。
mStr(k) = "0:" & Temp(j)

修正後に同じDATA、同じ関数で試してみましたが
表示に変化なく全く同じ結果が出力されました。
（一度、SAVE後にEXCELを開き直して試してみましたが変化は有りませんでした。）

まだ、凡ミスが隠れているようです。

回答No.25

kkkkkm

SplitExwT = mStr(k)
は
SplitExwT = mStr

補足

No.23のお礼までのコードに間違いはないと判断して、
以下のNo24-25の修正に変更後に同じDATAで試用してみました。

'// 置換
mStr(k) = mStr(k) = "0:" & Temp(j)
SplitExwT = mStr
Exit Function

出力結果は、前回と同じく以下の状況です。
何度もコードを変更してもらっているのに出力結果が変わらないのが不思議です。
（どこか根本的な所で私が又凡ミスをしているのでしょうか？）

関数
|[B]
[1]|=PERSONAL.XLSB!SplitExwT(A1,".","__","/",":")

|[A] |[B] |[C]
[1]|no1. CD1-8__Wish You Were Here 5:18|no1. CD1-8__Wish You Were Here|0:5:18
[2]|CD1-2__Rattle That Lock 5:23 |CD1-2__Rattle That Lock |0:5:23
[3]|CD1-10__In Any Tongue 0:07:47 |CD1-10__In Any Tongue |0:07:47
[4]|CD1-12__One Of These Days /6:32 |CD1-12__One Of These Days |0:6:32
[5]|CD2-2__Fat Old Sun /0:06:05 |CD2-2__Fat Old Sun |0:06:05