こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセルVBAで、セル内のテキストを二つ以上のスペースを基準に分割する

エクセルVBAで、セル内のテキストを二つ以上のスペースを基準に分割する方法。

A AA BBB CC CCC CC
DD EEE EE FF FF GG

のようなテキストがあり、二つ以上スペースがある場合、そこでセルを分割するモジュールを作ろうと考えています。
テキストの開始位置や、スペースx2の位置がセルによって違う上、区切りたいのスペース二つ以上なので、区切り位置ではできません。

現在はinstrで二つスペースがある位置を変数とし、midでそこから最後まで次にセルに出力した後、先ほどのInstrの変数をもう一度使い、元のセルのinstrで出した位置から最後までを消す。これをdo loopで繰り返す処理し、最後に空白のセルだけを全ていっぺんに消す方法を考えています。

しかし、この場合、一つのセルに対して何度も処理をしなければならない上、スペースが素数(例、3)の場合、出力されるセルにスペースが一つ入ってしまいます。また、スペースが30など多くある場合も、スペースだけのセルを複数を出力することになります。

この他に何か良いアイディアはないでしょうか?

投稿日時 - 2010-08-10 22:46:20

QNo.6101010

困ってます

質問者が選んだベストアンサー

>スペースが素数(例、3)の場合、出力されるセルに
>スペースが一つ入ってしまいます。
>また、スペースが30など多くある場合も、
>スペースだけのセルを複数を出力することになります。

 私は、#6 nda23 さんがお書きの「正規表現オブジェクト」をお使いになるのが妥当かと存じます。


#6 に対する「補足」より。。。
>functionプロシージャにするならば、セルA1を指定した場合、
>セルB1からC1,D1と、次々に分割されていくものであると助かります。

1)nda23 さんがお書きの コード をそのまま、標準モジュール に コピペ します。
2)「End Function」の行に ブレークポイント を設定します。
3)ローカルウィンドウ を開いておきます。
4)セルB1 に
=分割(A1)
と入力して [Enter] すると「End Function」の行で止まりますので、ローカルウィンドウ の「分割」の値を見てください。

 「分割」の値が「分割(0)」・「分割(1)」・「分割(2)」・・・・・・ というように、セルA1 の値が「二つ以上スペース」によって区切られた配列になっていることが判ります。

 従って、
>エクセルで使えるものだと助かります。
とお書きですが、そのまま、下記のようにすれば使うことができます。

 nda23 さんがお書きの コード と一緒に 標準モジュール に コピペ してください。


Sub macro()
 Dim i As Long
 Dim div As Variant
 For i = 1 To Range("A1").End(xlDown).Row
  div = 分割(Trim(Range("A" & i).Value))
  Range("B" & i).Resize(, UBound(div) + 1) = div
 Next i
End Sub


 A列のデータを残さなくてもよいのなら、
  Range("B" & i).Resize(, UBound(div) + 1) = div
のところを
  Range("A" & i).Resize(, UBound(div) + 1) = div
に変えてください。

投稿日時 - 2010-08-12 22:29:36

お礼

ありがとうございます。

もう一つ質問があるのですが、
この場合、iをまわしている最中、AAAのようにスペースが入っていないセルがあった場合、divにvariableが入っていないので、止まってしまいます。
それを避けるために、下記のようにして途中で止まるのを避けたいのですが、TRUEにたいして、type mismatchとエラーメッセージが出てしまいます。
何がいけないのでしょうか?

Dim i As Long
Dim div As Variant
Dim mycheck As Boolean
For i = 1 To Range("A1").End(xlDown).Row
div = bunkatsu(Trim(Range("A" & i).Value))
mycheck = IsEmpty(div)
If mycheck Is True Then
Next i
Else
Range("B" & i).Resize(, UBound(div) + 1) = div
End If
Next i

投稿日時 - 2010-08-16 22:12:51

ANo.10

このQ&Aは役に立ちましたか?

3人が「このQ&Aが役に立った」と投票しています

回答(11)

ANo.11

>この場合、iをまわしている最中、
>AAAのようにスペースが入っていないセルがあった場合、
>divにvariableが入っていないので、止まってしまいます。

 ぉゃ~ん?
 私の環境では、
>AAAのようにスペースが入っていないセルがあった場合、
>divに
は「div(0)="AAA"」という要素が入って、別にエラーにもなりませんが。。。

#もっとも、それを含めて検証済みの前回答でしたので。。。


>AAAのようにスペースが入っていないセルがあった場合、
ではなくて、何も入っていない「空セル」が途中にあるのではありませんか?

 そういうことでしたら、「div」は「<変数なし>」であって「Empty」ではなさそうですので、「IsEmpty 関数」を使って判定するのではなくて、前回答の マクロ の コード を

Sub macro()
 Dim i As Long
 Dim div As Variant
 For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
  If Range("A" & i).Value <> "" Then
   div = 分割(Trim(Range("A" & i).Value))
   Range("B" & i).Resize(, UBound(div) + 1) = div
  End If
 Next i
End Sub

というようなことに書き換えることで、問題は回避されます。


 もしくは、どうしても、「div」の値によって分岐処理をなさりたいというようなことでしたら、

Dim i As Long
Dim div As Variant
Dim mycheck As Long
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
 div = bunkatsu(Trim(Range("A" & i).Value))
 mycheck = UBound(div)
 If mycheck > -1 Then
  Range("B" & i).Resize(, UBound(div) + 1) = div
 End If
Next i

みたいな感じになりましょうか。。。

投稿日時 - 2010-08-16 23:50:37

ANo.9

悪夢にうなされそうなのでお詫びですm(_ _)m
Sub macro2()
  '参照設定:Microsoft Forms 2.0 Object Library
  Dim 正規表現
  Dim テキスト As String
  
  Set 正規表現 = CreateObject("VBScript.RegExp")
  正規表現.Global = True
  正規表現.Pattern = " {2,}"
  Range("A1", Cells(Rows.Count, 1).End(xlUp)).Copy
  With New DataObject
    .GetFromClipboard
    テキスト = .GetText(1)
    .Clear
    .SetText 正規表現.Replace(テキスト, vbTab)
    .PutInClipboard
  End With
  Range("A1").PasteSpecial
End Sub

投稿日時 - 2010-08-11 19:59:17

ANo.8

ぁ、失礼しました。
No.1,2 rukukuさんの♪案のほうが手順少ないので私のは却下でお願いします。
すみません、また勘違いしましたorz

投稿日時 - 2010-08-11 19:13:36

ANo.7

一応、状況が許せばこんなのも考えられますが...
Sub Macro1()
  With Range("A1", Cells(Rows.Count, 1).End(xlUp))
    '.Value = Application.Text(.Cells, "|@|")
    .Value = Application.Substitute(.Cells, " ", " ")
    .Value = Application.Trim(.Cells)
    .TextToColumns DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, _
            Tab:=True, _
            Semicolon:=False, _
            Comma:=False, _
            Space:=False, Other:=True, _
            OtherChar:=" "
    '.CurrentRegion.Replace What:="|", _
                Replacement:="", _
                LookAt:=xlPart, _
                MatchCase:=False
  End With
End Sub

Substitute関数の箇所は
..Substitute(.Cells, "半角スペース2個", "全角スペース1個")
TextToColumnsのOtherCharは..OtherChar:="全角スペース1個"
です。

#例示の2行目はあえて"スペースDD.."になってるような。
冒頭と末尾のスペースを省くと困る場合はそのままTrimでは拙いですから
コメントアウトしてる処理を追加する必要があります。
ちょっと回りくどい気がしますね。
No.6 nda23さんの正規表現のほうがスマートに処理できるのでそちらをおすすめします。

投稿日時 - 2010-08-11 18:57:35

ANo.6

正規表現オブジェクトとSplit関数を組み合わせます。

Function 分割(ByVal テキスト As String) As String()
Dim 正規表現
Set 正規表現 = CreateObject("VBScript.RegExp")
正規表現.Global = True
正規表現.Pattern = " {2,}"
分割 = Split(正規表現.Replace(テキスト, vbTab), vbTab)
End Function

正規表現のGlobalは全体に対してという意味で、Falseの場合は
最初に一致した所で処理が終わってしまいます。
Patternに指定した文字列は「空白が2個以上」という意味です。
Patternに一致した部分(2個以上の空白)をタブ1文字に変換し、
更にタブによりSplitします。これで有効文字列の配列が作られます。
分割された文字列の前方、あるいは後方に空白が含まれることは
ありません。正規表現は下記URLを参照してください。

http://msdn.microsoft.com/ja-jp/library/cc392487.aspx
http://msdn.microsoft.com/ja-jp/library/cc392020.aspx

投稿日時 - 2010-08-11 09:41:21

補足

これは、メモ帳を使用したVBSでしょうか?
丁寧に回答して下さった上、自分が質問欄で記載し忘れたことなので、非常に申し訳ないのですが、
エクセルで使えるものだと助かります。

また、分割したいテキストが大量にあるので、例えば、functionプロシージャにするならば、セルA1を指定した場合、セルB1からC1,D1と、次々に分割されていくものであると助かります。

投稿日時 - 2010-08-11 19:57:31

ANo.5

色々言っているが良くわからない。Split関数を知っていますか。
Sub test01()
a = "aaa bbb c"
s = Split(a, " ")
For i = 0 To UBound(s)
MsgBox s(i) & "*"
Next i
End Sub
のaの右辺の文字列のプペースの数と
s = Split(a, " ") の" "の中を半角スペースなどの1つ2つなどに変えて
、色々テストしてみて、Split関数でダメですか。
s = Split(a, " ") のスペースの数がaの中のスペースの数より大きいと分割されない。
それで良いのでは。

投稿日時 - 2010-08-11 00:00:21

補足

split関数で、指定した文字列毎に別れたArrayを作り、
Arrayの最大値(配列の最後)をuboundで取得し、
同時にuboundで取得した数値を、またArrayにすることで、
分割先のセルを指定し、そこに貼り付けるということでしょうか?

投稿日時 - 2010-08-11 17:54:31

ANo.4

ANo3です

すみません勘違いしてましたNo3は無視してください。

投稿日時 - 2010-08-10 23:19:46

ANo.3

Range("A3").TextToColumns Destination:=Range("A3"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, _
FieldInfo:=Array(Array(1, 2), Array(2, 1), Array(3, 2), Array(4, 1), Array(5, 2), _
Array(6, 1), Array(7, 2), Array(8, 1))


ひとつの例ですRange("A3")を適当に変更してください。

投稿日時 - 2010-08-10 23:16:46

ANo.2

表現が分かりにくかったので補足します。

>「♪」がテキスト中に出てくる場合には、他の絶対に出てこない文字に置き換えてください。

置換するのではなく「他の文字を使ってください」ということです。

投稿日時 - 2010-08-10 23:05:39

ANo.1

こんばんは

次のステップはいかがでしょうか。
1.「スペース×2」を「♪」に置換
2.「♪+スペース」を「♪」に置換
3.データ-区切り位置で、「区切り文字-♪(連続した区切り文字は…にチェック)」

「♪」がテキスト中に出てくる場合には、他の絶対に出てこない文字に置き換えてください。

投稿日時 - 2010-08-10 23:02:11

あなたにオススメの質問