分割マクロ

質問

よろしくお願いします。写真のように、一つの文字列に空白スペースが何ヵ所かあり、それを3分割に分けたいのですが、M列からO列が欲しい結果なのです。しかし、5行目のようにスペースがないものは、N列にしたいのです‼find関数Len関数left.right関数を駆使して、やっても良いのでしょうが、5行目、6行目のようにスペースが、たくさんあるものは、時間がかかりそうです。結局のところ、最初と最後の文字列にを抜き出し、残りは、N列にしたいのです。なにか、良いマクロ教えて下さい。よろしくお願いします。尚、スペースは全角スペースです。

回答No.7

real beatin（@realbeatin） · ベストアンサー

こんにちは。お邪魔します。

> 5行目、6行目のようにスペースが、たくさんあるものは、時間がかかりそうです
解決までに時間が掛かる、という意味だったのでしょうか？
それとも、行数が多過ぎて、計算が終るのに時間が掛かる、でしょうか？
ふたつの意味で気になったのと、解決が長引いている理由を想像してみて、
指定した範囲に空白セルが存在する場合などのことも加味して、回答します。

> 最初と最後の文字列にを抜き出し、残りは、N列にしたいのです
仮にスペースが１つだけの場合があれば、中央N列を空にして、
両端M,O列に振り分ける、という仕様と理解しました。

元データにエラー値が混じっているとか、
３分割した先の文字列が255文字を超えるとか、
そういう場合にはうまく機能させられませんけれど、
結構意地悪なサンプル作って動作確認しています。
無いでしょうど、全角スペースのみ、３つ以上並んでいる場合は、
M N O列皆、空白になります。（N列に全角スペースだけ並びはしません。）

以下、色々作っていた中で妥当性のありそうなもの、
VBAを２例（簡易版と高速版）、数式を１例、です。
（VBAは、L列最下のデータ行まで処理します。）

' '　―――――――――――――――――――――――――――――
' ' // vba　簡易版　※使っているのはMid関数ではなく、Midステートメントです
Sub piyo()
Dim v, a, i As Long
　　For i = 3 To Cells(Rows.Count, "L").End(xlUp).Row
　　　　v = Cells(i, "L")　'　元の値
　　　　a = Split(v, "　")　'　区切り文字で分割した文字列配列
　　　　Select Case UBound(a)　'　区切り文字の数で分岐
　　　　Case 0: Cells(i, "N") = v
　　　　Case 1: Cells(i, "M") = a(0): Cells(i, "O") = a(1)
　　　　Case Is > 1
　　　　　　Mid(v, InStr(v, "　")) = vbCr　'　最初の区切り文字をCrに
　　　　　　Mid(v, InStrRev(v, "　")) = vbCr　'　最後の区切り文字をCrに
　　　　　　Cells(i, "M").Resize(, 3) = Split(v, vbCr)　'　Cr区切りで分割した文字列配列
　　　　End Select
　　Next i
End Sub
' '　―――――――――――――――――――――――――――――

' '　―――――――――――――――――――――――――――――
' ' // vba　大量データ向き、高速（配列入出力）版
Sub fuga()
Dim m, a, i As Long
　　m = Range("L3:L" & Cells(Rows.Count, "L").End(xlUp).Row).Value
　　ReDim Preserve m(1 To UBound(m), 1 To 3)
　　For i = 1 To UBound(m)
　　　　a = Split(m(i, 1), "　")
　　　　Select Case UBound(a)
　　　　Case 0: m(i, 2) = m(i, 1): m(i, 1) = Empty
　　　　Case 1: m(i, 1) = a(0): m(i, 3) = a(1)
　　　　Case Is > 1
　　　　　　m(i, 1) = a(0): a(0) = Empty
　　　　　　m(i, 3) = a(UBound(a)): a(UBound(a)) = Empty
　　　　　　m(i, 2) = Trim$(Join(a, "　"))
　　　　End Select
　　Next i
　　Range("M3:O" & Cells(Rows.Count, "L").End(xlUp).Row).Value = m
End Sub
' '　―――――――――――――――――――――――――――――

数式
――――――――――――――――――――――――――――――
M3
=LEFT(L3,IFERROR(FIND("　",L3),1)-1)
N3
=TRIM(MID(L3,LEN(M3)+1,LEN(L3)-LEN(M3)-LEN(O3)))
L3
=MID(L3,MAX(IFERROR(FIND("　",L3,ROW($2:$256)),1)+1),100)
――――――――――――――――――――――――――――――
L3だけは、Ctrl+Shift+Enterで確定して、数式バーに、
{=MID(L3,MAX(IFERROR(FIND("　",L3,ROW($2:$256)),1)+1),100)}
と表示され、配列（CSE）数式として設定されたことを確認します。
M3:O3 を必要なだけフィルダウンします。
――――――――――――――――――――――――――――――

以上、ご参考まで。
既出のご回答で解決に十分なものが得られていたのでしたら、
こちらの杞憂、むしろ幸い、と思っております。

回答No.6

Nouble

もう一度、掲載して
おきます
どうぞ
お使い、ください
https://1drv.ms/x/s!AjviygfJDgV_1G0zl6Cl0I1yl3vN

回答No.5

mt2015

例題の文字列はAやBなど一文字ですが、実際にはもっと長い文字列が全角スペースで結合されているのではないですか？
手抜きマクロですが作ってみました。

Sub sample()
　　For r = 3 To 6
　　　　sData = Trim(Cells(r, "L").Text)
　　　　sSpData = Split(sData, "　")

　　　　If UBound(sSpData) = 0 Then
　　　　　　Cells(r, "N") = sData
　　　　Else
　　　　　　Cells(r, "M") = sSpData(0)
　　　　　　Cells(r, "O") = sSpData(UBound(sSpData))
　　　　　　nStart = Len(Cells(r, "M")) + 2
　　　　　　nLong = Len(sData) - nStart - Len(Cells(r, "O"))
　　　　　　Cells(r, "N") = Mid(sData, nStart, nLong)
　　　　End If
　　Next r
End Sub

回答No.4

imogasi

標題の「分割マクロ」というのは適当でない。なんのことかと思う。
質問者はマクロをそんなに得意としていないようだし、関数でもできるかもしれないのだから、したいことを文章に表現して、「ＶＢＡでの回答も可」、とすればよい。
最初の文字をＭ列へ
最後の文字をＯ列へ
第2文字から最終の文字の１文字前までＮ列へ分離したい
とでも、表現したら仕舞ではない？
Ａ列　　　　　Ｄ、Ｅ、Ｆ列
ABC A B C
ABCD A BC D
A A A
ABCDE A BCD E
AB A B
Ｄ列の式　=LEFT(A1,1)
Ｅ列の式　=IF(LEN(A1)>1,MID(A1,2,LEN(A1)-2),"")
Ｆ列の式　=RIGHT(A1,1)
これで質問を誤解しているかな。
ＶＢＡでもこれらの
関数は使えるので、IF文かCase文で分ければ仕舞。
なぜマクロという発想になったのか？

回答No.3

Nouble

作って、おきました
リンク先に、あります
ご参照、くださいね

此れで、構いませんか？

参考URL：

https://1drv.ms/x/s!AjviygfJDgV_1F2Eflyu7yZwQaQn

お礼

ご回答ありがとうございます。今日は、出先になるみないなので、後日試させていただきます。助かります

補足

今スマホで確認すると。エラーがでます。後でもかまいませんので、よろしくお願いします。

回答No.2

山田 太郎（@f_a_007）

７０歳になった爺ですが・・・

? CutStr("A B C D E", " ", 1)
A
? CutStr("A B C D E", " ", ChrCount("A B C D E", " ")+1)
E
? Trim(Replace(Replace("A B C D E", CutStr("A B C D E", " ", 1), ""), CutStr("A B C D E", " ", ChrCount("A B C D E", " ")+1), ""))
B C D

20年前に書いた CutStr()とChrCount() とを組み合わせても出来ますね。

１、最初の文字は、CutStr()で抜き出す。
２、最後の文字も、CytStr()で抜き出す。
　　何番目かは ChrCount() で計算する。
３、最初と最後を抜き出すには、１と２を""に変換するだけ。

なお、次の CutStr()とChrCount() とは標準モジュールに登録して利用します。

Public Function CutStr(ByVal Text As String, _
　　　　　　　　　　　　ByVal Separator As String, _
　　　　　　　　　　　　ByVal N As Integer) As String
　　Dim strDatas() As String

　　strDatas = Split("" & Separator & Text, Separator, , 0)
　　CutStr = strDatas(N * Abs(N <= UBound(strDatas)))
End Function

Private Function CharCount(ByVal Text AS String, _
　　　　　　　　　　　　　　ByVal C As String) As Integer
　　Dim I As Integer
　　Dim L As Integer
　　Dim N As Integer

　　L = Len(Text)
　　For I = 1 To L
　　　　N = N + Abs(strComp(Mid$(Text, I, 1), C, vbTextCompare) = 0)
　　Next I
End Function

【補足】

ただし、一文字の時は、もうひと工夫する必要あり。ということは、添付図の処理を一つの関数にまとめるのが現実的。Ifで分岐するだけだが、長くなりすぎ。で、添付図の１番目、２番目、３番目、そして一文字にも対応する関数にした方が簡単。CutStr()、ChrCount()を利用すればチャッチャッだと思う。でも、７０の爺が２０年前に考えたこと。もっと新しいやり方があるかも・・・。

お礼

みなさんご回答ありがとうございます。pcは会社なので、後日試させていただきます。

回答No.1

f272

こんな感じ？
Sub main()
Set r = Range("L3")
Do
s = Trim(r.Value)
j = InStr(s, " ") 'ここは全角スペース
If j > 0 Then
r.Offset(, 1) = Left(s, j - 1)
s = Trim(Mid(s, j + 1))
End If
s = StrReverse(s)
j = InStr(s, " ") 'ここは全角スペース
If j > 0 Then
r.Offset(, 3) = StrReverse(Left(s, j - 1))
s = Trim(Mid(s, j + 1))
End If
s = StrReverse(s)
r.Offset(, 2) = s
Set r = r.Offset(1)
Loop While Not IsEmpty(r)
End Sub

お礼

早速の回答ありがとうございます。pcは会社保管なので後日試させていただきます。