[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『最初の半角又は全角スペースで文字列分割』（takeshi）
A列の複数の文字列を最初の全角スペースで２つに分割するVBAのコード
ですが、スペースが半角の場合でも対応できるようにしたい。
（区切りのスペースが半角か？全角か？が統一されていないケースを想定、
但しスペースは文字列中に複数存在するケースがあります。）
Sub splitColumn()
Dim lastRow As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
Dim arr() As String
Dim i As Long
For i = 1 To lastRow
arr = Split(Cells(i, 1), " ", 2)
Cells(i, 2) = arr(0)
Cells(i, 3) = arr(1)
Next i
end sub
＜ 使用 Excel：Excel2021、使用 OS：Windows10 ＞
参考HPです。
https://jizilog.com/vba-instrcovertop
（MK） 2023/06/21(水) 07:28:15
Instr で指定の区切り文字が対象文字列の左から何番目 に出てくるか、を取得します。
指定の区切り文字が半角/全角を問わず、だったら StrConv で指定区切り文字、対象文字列両方を半角ある いは全角に統一します。
あとは、Instrで取得した位置で参照文字列をLeft 関数やRight関数(あるいはMid関数)で切り出します。 （MK） 2023/06/21(水) 07:48:13
現在、コードも進行して以下のような状況です。
アドバイスを参照してコード中の//// 変更予定箇所 ////を以下のように変更してみましたが
「型が一致しません」となりますが、検索文字列がスペースではできない相談ですか ？
arr1 = InStr(StrConv(UCase(Cells(i, 1).Value), vbNarrow), " ")
Sub splitColumn()
Dim lastRow As Long
Dim arr1() As String, arr2() As String
Dim i As Long, ii As Long
Dim count As Long
lastRow = Cells(Rows.count, "A").End(xlUp).Row
'B列の書式を「文字列」に設定
Range("B1:B" & lastRow).NumberFormat = "@"
For i = 1 To lastRow
arr1 = Split(Cells(i, 1), " ", 2) '------＞ //// 変更予定箇所 ////
arr2 = Split(arr1(0), ":")
For ii = LBound(arr2) To UBound(arr2)
count = count + 1
Next
If count - 1 = 1 Then
arr2(0) = Left(arr2(0), 5)
End If
Cells(i, 2) = CStr(arr1(0))
Cells(i, 3) = arr1(1)
Cells(i, 1) = Cells(i, 2) & " " & Cells(i, 3)
Next i
End Sub （takeshi） 2023/06/21(水) 08:07:47
データ→区切り位置は全角半角を区別しないので、
Sub samle1()
Columns("A:A").TextToColumns Destination:=Range("B:B"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
End Sub
とか
先に置き換えるとか
Sub sample2()
Dim aCell As Range
For Each aCell In Range("A1", Cells(Rows.Count, "A").End(xlUp))
aCell.Offset(, 1).Resize(, 2).Value = Split(Replace(aCell.Value, " ", " "), " ")
Next
End Sub
すればいいんでは
（´・ω・`） 2023/06/21(水) 08:55:01
あ、かぶった...
>但しスペースは文字列中に複数存在するケースがあります
ちょっと、お勉強でしてみたのですが^^; スペースがある分の、全てをB列から右に分割すれば いいのでしょうか？
Sub SplitColumn_Sample()
Dim tmp As Variant, i As Long, q As Long, LastR As Long
LastR = Cells(Rows.count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For q = 1 To LastR
'全角スペースを、半角スペースに置換
tmp = Replace(Cells(q, 1), " ", " ")
'スペースがあれば、全て分割する
tmp = Split(tmp, " ")
'最初のスペースで、2列に分割する
'tmp = Split(tmp, " ", 2)
For i = LBound(tmp) To UBound(tmp)
Cells(q, 2 + i) = tmp(i)
Next i
Next q
Cells(1).CurrentRegion.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
意味が違ったら、ゴミ箱へ...ポイっとしてください。 （あみな） 2023/06/21(水) 08:57:49
´・ω・`さん、あなみさん アドバイスありがとうございます。
全角スペースを全て半角スペースに変換して処理する
コードを考えてみましたが不具合ありましょうか ？
For i = 1 To lastRow
str = Replace(Cells(i, 1), " ", " ")
arr1 = Split(str, " ", 2)
（takeshi） 2023/06/21(水) 09:01:44
>最初の全角スペースで２つに分割 あ、これが大事なんですね。私のは条件を満たしませんね すみません （´・ω・`） 2023/06/21(水) 09:03:16
>最初の全角スペースで２つに分割するVBAのコード >ですが、スペースが半角の場合でも対応できるようにしたい ~~~~~~ 例としての意味ではないのかな？ ちゃうん？ （あみな） 2023/06/21(水) 09:10:31
じゃあ、↓これでよくない？
str = Replace(Cells(i, 1), " ", " ")
↓変換後に書き出し
arr1 = Split(str, " ", 2) （あみな） 2023/06/21(水) 09:12:56
一応、以下の条件で考えました a)最初の空白（全角でも半角でも）で前後2つに区切る b)それ以外の空白には影響を与えない 置換を使うとb)を満足しない場合があるのでやめました
Sub sample3()
Dim aCell As Range
For Each aCell In Range("A1", Cells(Rows.Count, "A").End(xlUp))
aCell.Offset(, 1).Resize(, 2).Value = SplitbySpace(aCell.Value)
Next
End Sub
Function SplitbySpace(s As String) As Variant()
Dim i As Long, j As Long
i = InStr(s, " ")
j = InStr(s, " ")
If j < i Then i = j
If i < 1 Then
SplitbySpace = Array(s)
Else
SplitbySpace = Array(Left(s, i - 1), Mid(s, i + 1))
End If
End Function
（´・ω・`） 2023/06/21(水) 09:15:52
・ω・ さんの、sample3 ちょっとあやしい...ような
↓これでいいような気がする^^;
Sub SplitColumn_Sample()
Dim tmp As Variant, i As Long, q As Long, LastR As Long
LastR = Cells(Rows.count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For q = 1 To LastR
'全角スペースを、半角スペースに置換
tmp = Replace(Cells(q, 1), " ", " ")
'最初のスペースで、2列に分割する
tmp = Split(tmp, " ", 2)
For i = LBound(tmp) To UBound(tmp)
Cells(q, 2 + i) = tmp(i)
Next i
Next q
Cells(1).CurrentRegion.EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub
（あみな） 2023/06/21(水) 09:24:29
またまたごめんなさい Split関数のオプションをちゃんと理解してませんでした。 これだけでＯＫなんじゃないかと
Sub sample4()
Dim aCell As Range
For Each aCell In Range("A1", Cells(Rows.Count, "A").End(xlUp))
aCell.Offset(, 1).Resize(, 2).Value = Split(aCell.Value, " ", 2, vbTextCompare)
Next
End Sub
>・ω・ さんの、sample3 ちょっとあやしい...ような 例えばどんな？ （´・ω・`） 2023/06/21(水) 09:26:19
・ω・ さん、ちょっと待ってください （あみな） 2023/06/21(水) 09:28:24
・ω・ さんの、sample3 下になりません？
●A列は元のデータ
|[A] |[B] |[C]
[1]|A列の 複数の 文字列を 最初の 全角スペースで ２つに |A列の |複数の 文字列を 最初の 全角スペースで ２つに
[2]|A列の 複数の 文字列を 最初の 全角スペースで ３つに|A列の 複数の 文字列を 最初の 全角スペースで ３つに|A列の 複数の 文字列を 最初の 全角スペースで ３つに
[3]|A列の 複数の 文字列を 最初の 全角スペースで ４つに |A列の |複数の 文字列を 最初の 全角スペースで ４つに
（あみな） 2023/06/21(水) 09:34:08
もう一度希望を明確にすると
文字列を左から数えて最初のスペース（全角でも半角でもどちらでも）で２つに分割するです。
私の考えた（09：01：44）のコードでは、希望は満たしますが
（´・ω・`）さんの(09：15：52）のb)までは考慮していませんでした。
（全てスペースを半角に変換して処理するから）
個人的には、b)まで考慮しなくても良さそうなの自前のSIMPLEなコードで処理して
問題が出そうならアドバイスを参考にb)も考慮したいとおもいます。
（takeshi） 2023/06/21(水) 09:44:49
あみなさん ほんとですね 完全に見落としでした
sapmle3は見なかったことにしてください すみません
Split関数でvbTextCompareを指定すれば全て丸く収まると思いますが... （´・ω・`） 2023/06/21(水) 09:52:35
sapmle3 は見なかったことにします。ｷｬｯ♪(*ﾉдﾉ)見ないでッ！
・ω・ の sample4 が一番いい(きっと) （あみな） 2023/06/21(水) 10:17:07
arr1 = Split(ws.Cells(i, 1), " ", 2, vbTextCompare)
（takeshi） 2023/06/21(水) 11:11:21
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.