文字列に含まれる日付を分割

質問

またも教えてください。
さきほどの質問と似ているのですが、、、申し訳ございません。

ひとつのセルに日付と文字が混在しています。
（他に数字データもあります）
～～～、5/1定休日、5/5定休日
～～、5/1定休日
～～～、10/10定休日

～～には何が入るかわかりません。（数字だったり文字だったり）
「定休日」の文字列は固定です。
これを
5/1　　5/5
5/1　　
10/10
とセルを分けたいのですが、、、。日付の桁数が揃っていないので
どうしてもきれいに抽出できません。（涙）
お知恵をください。よろしくお願いいたします。

回答No.7

zap35 · ベストアンサー

元のデータがA1:A3にあるとき、同じシートの適当なセルに以下の式を貼り付けて、右方向、および下方向にコピーしてください

=IF((LEN($A1)-LEN(SUBSTITUTE($A1,"定休日","")))/3>=COLUMN(A1),MID(LEFT($A1,FIND("@",SUBSTITUTE($A1,"定休日","@",COLUMN(A1)))-1),FIND("[",SUBSTITUTE($A1,"、","[",COLUMN(A1)))+1,LEN($A1)),"")

ただし制限があります
(1)文字列中に"@"と"["があるとうまく動きません
　　その場合は使っていない文字列に式中の"@"と"["を置き換えます
(2)「、（全角読点）」に続く日付を抽出対象としますのでデータの先頭に「～～、」がないとエラーになります
　　式をもっと長くして良いならそれにも対応できる式は書けそうですが、
　　時間がないのでそこまでは考えませんでした。
　　必要ならご自身で工夫してみてください。

お礼

回答いただきありがとうございます。
貼り付けてみたのですが、うまくいきません。
たしかに「～、」が存在しない場合もあるのですが
それは工夫してみますが・・・。
サンプルでは「定休日」としたのですが、実際の言葉が違い
文字数が全角２文字だからでしょうか。。。
（最初に/3しているのに関連？）
もう少し読み解いてみます。すみません。

補足

お礼をしたあとの補足ですみません。
やはり３文字⇒２文字が悪さをしていました。
その部分と、データ先頭部分にいきなり日付が来るケースを
工夫をして解決しました。ありがとうございました！

回答No.9

noname#140971

＞エクセルの関数を使うのであれば、SUBSTITUTEで生成した文字列から"、"から右を抜き出せばいいです。

=SUBSTITUTE(A1 & "、","定休日、"," ")

～～～、5/1定休日、5/5定休日--------------->～～～、5/1 5/5
～～、5/1定休日---------------------------->～～、5/1
～～～、10/10定休日------------------------>～～～、10/10
～～～、5/1定休日、5/5定休日、5/10定休日--->～～～、5/1 5/5 5/10

と、SUBSTITUTE関数で対象文字列の形式を単純化。

=MID(B1,FIND( "、",B1,1)+1, 1000)

で、MID関数とFIND関数で"、"の右を抜き出します。

～～～、5/1 5/5---------------->5/1 5/5
～～、5/1---------------------->5/1
～～～、10/10------------------>10/10
～～～、5/1 5/5 5/10 ---------->5/1 5/5 5/10

これにエラー対策を加えれば・・・。

※昨日の中途半端な回答を一応補足しておきます。
※エクセルは操作したことがないので、こんな初歩的な手法しか私には無理。

お礼

ありがとうございました。
Excel操作したことないとは思えないわかりやすい回答です。
エラー対策を考えて今まで回答いただいた方のものと
組み合わせてみます。

回答No.8

maron--5

◆こんな方法もありますよ
=IF(COLUMN(B1)>LEN($A1)-LEN(SUBSTITUTE($A1,"、",))+1,"",SUBSTITUTE(TRIM(MID(SUBSTITUTE($A1&"、","、",REPT(" ",40)),40*COLUMN(B1)-39,40)),"定休日",))
★右と下にコピー

お礼

ありがとうございます！
質問のサンプルが正確でなかったことを後悔していますが
～、がないパターンがあったのと、もうひとつ、～、～、5/1定休日
というパターンがあり、その場合にふたつめの～、が読まれて
しまいました。
ちょっと工夫して右から読むように考えて見ます。
みなさまのアイデアには本当に脱帽です。。。

回答No.6

onlyrom

区切り文字が　、（全角読点）としています。
これで切り分けをしますので、他の区切り文字では動作しない。
ゆえに、区切り文字は実際に合わせて修正のこと。

'--------------------------------------------
Sub Test()

　Dim myArray
　Dim myValue
　Dim K As Integer
　Dim R As Long
　Dim Clm As Integer

　For R = 1 To Cells(Rows.Count, "A").End(xlUp).Row
　　　Clm = 0
　　　myValue = Replace(Cells(R, "A"), ",", "、")　　'●●●
　　　myArray = Split(myValue, "、")

　　　For K = LBound(myArray) To UBound(myArray)
　　　　　If InStr(myArray(K), "定休日") > 0 Then
　　　　　　　Clm = Clm + 1
　　　　　　　Cells(R, "A").Offset(, Clm).Value = Replace(myArray(K), "定休日", "")
　　　　　End If
　　　Next K
　Next R

End Sub
'--------------------------------------------------

●●●のmyValue = Replace(Cells(R, "A"), ",", "、")
これで試しに　,（半角コンマ）は、全角読点に変えています。
これを利用して色々な区切り文字を統一して実行のこと。
以上。

お礼

回答ありがとうございました。
確かに区切り文字が統一されていないので
さまざまなパターンを想定して仕込む必要があるようです。
参考にさせていただきます！

回答No.5

heinell

手動でやるなら(Excel2003の場合)

1.定休日を未入力（空欄）で置換
2.メニュー、データ(D)→区切り位置→カンマやタブなどの区切り文字に…→その他にチェック・後ろの入力欄に「、」の文字
次のメニューで最初の分を削除したり、日付型に指定するのもOK
3.表示書式を変更（セルの書式設定で日付かユーザー設定でmm/ddとか）

こういう手もあります。
セル位置が固定なら、マクロ記録するのも手でしょう。

お礼

区切り文字は思いつきませんでした。
（/を探して桁数を抜こうとしていました）
ただ、「、」が複数ある場合もあり、
行数も大量にあって対象セルを探すのが大変なので
なかなか厳しいかもしれません。
ありがとうございました。

回答No.4

hallo-2007

置き換えの機能ではダメでしょうか？
取合えず、別のシートにでもコピィして
置き換え
検索する文字列　定休日
置き換え後の文字列　　空白のまま　
全てを置き換えで　
定休日と言う文字が外れて日付になると思います。

お礼

回答ありがとうございます。
他にも数字やらなんやらがセルに入っており、
しかも行数が大量にあるために置換では対応できないのです。
がんばってみます。

回答No.3

n-jun

ANO.1です。
>NEXTのあとがよくわからないです。

vv　=　Split(ss,　",")
文字列ss（","で連結したもの）を","で区切って配列vvに放り込む。

If　ss　<>　""　Then
文字列ssが""でない時、

c.Offset(,　1).Resize(,　UBound(vv))　=　vv
Ａ列の１つ右（Ｂ列の同行）から区切ったvvの数だけ、右方向のセルに
代入する。

End　If

と言った所でしょうか。

お礼

わざわざありがとうございます。
意味がわかりました。
関数では限界がありそうなので、挑戦してみます。

回答No.2

noname#140971

～～～、5/1定休日、5/5定休日＿＿＿5/1 5/5
～～、5/1定休日＿＿＿＿＿＿＿＿＿＿5/1
～～～、10/10定休日＿＿＿＿＿＿＿＿10/10

=CutStr(SUBSTITUTE(A1 & "、","定休日、"," "),"、",2)

エクセルの関数を使うのであれば、SUBSTITUTEで生成した文字列から"、"から右を抜き出せばいいです。

お礼

関数で挑戦したのですが、数字列が入り込んでしまいました。
工夫してみます。

回答No.1

n-jun

セルＡ１からＡ１０までの日付をＢ列より右に書き出すサンプル。

Sub　Try()
　　Dim　c　As　Range,　ss　As　String
　　Dim　v　As　Variant,　vv
　　With　CreateObject("VBScript.RegExp")
　　　　.Pattern　=　"(\d*\/\d*)|[０-９]*\／[０-９]*"
　　　　.Global　=　True
　　　　For　Each　c　In　Range("A1:A10")
　　　　　　ss　=　""
　　　　　　For　Each　v　In　.Execute(c.Value)
　　　　　　　　ss　=　ss　&　v.Value　&　","
　　　　　　Next
　　　　　　vv　=　Split(ss,　",")
　　　　　　If　ss　<>　""　Then
　　　　　　c.Offset(,　1).Resize(,　UBound(vv))　=　vv
　　　　　　End　If
　　　　Next
　　End　With
End　Sub
こうゆう事ですか？

お礼

n-junさん
早速ありがとうございます。
すみません。NEXTのあとがよくわからないです。
（きっとここが大事・・・）
VB本とにらめっこしてみます。^^;