[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『つながった文字列を分ける方法』（よし）
たとえば１２３４５６７という文字列を３と４で区切って別々のセルに表示させる簡単な方法は
ありますか
どのような法則の元にわけるのでしょうか？ 例えばなら =LEFT(A1,3)と=MID(A1,4,4)とか区切り位置ウィザードを使うとか （ケン）
=(LEFT,A1,3)
その横に
=(RIGHT,A1,4)
正解かな？？
（藤本９）
=LEFT(A1,3)と=RIGHT(A1,4)でしょう〜（^_^) （ケン）
そうなると話が違ってきますね。名前の文字数とか色々各セルで文字数が違うでしょうから・・・ 答えになっていませんが・・・ やはり地道に名前、電話番号、住所の間にスペース等で区切り、区切り位置ウィザード で区切るのが良いのではないでしょうか?ん〜、他にいい方法が有るかなぁ〜 検討中 （ケン）
（藤本９）
こんな時こそユーザー関数や思いまんねんけどなぁ、ケンさん。最近なんぼユーザー 関数書いてもVBAは分かりまへんっちゅうて肘鉄食らうばっかしで、腰が引けてきまし たわ。 よしさん分かってくれまっしゃろか、ユ ー ザ ー 関数っちゅうのん。 よしさん固有の関数の事で、普通の関数と全く同じに扱えます。 もし、ご入用でしたらカキコしとっておくんなはれ。丁寧に説明してさしあげます。 ほな...（弥太郎）
[弥太郎]さん、ぼやかない、ぼやかない。 きっと、いいときもありますって。
私はプログラマなのでどちらかというと、ユーザー関数ですっきり 作るほうが好きです。
でも、一般的にはまだまだユーザー関数やマクロは雲の上のもので、 数式や標準関数を使う人が多いのは確かです。
一番問題なのは、ユーザー関数にしても、それを作った人が どっか行っちゃったら、ブラックボックスになることです。 （kazu）
はい！教えてちょ〜。一生懸命勉強します。 よしさん代理人（ケン）
電話番号って市外局番から入力してあれば、必ず0始まりですよね？0から始まることを
前提にお話します。A列の名前、電話番号、住所が入力されているとします。B1に
=LEFT(A1,FIND("0",A1)-1)として下にコピー、C1に=MID(A1,FIND("0",A1),LEN(A1)-FIND("0",A1))
で下にコピーでB列に名前C列に電話、住所になります。B列とC列のコピーして形式を選択
して貼付けで値のみ貼付けC列を区切り位置ウィザードで電話番号と住所を区切ります。
但し、携帯番号などが含まれていると桁数が変わるので、この方法もダメです。
参考までに、です。弥太郎さんの出番を楽しみに待っててください。（ケン）
ケンさん、Yosh!です。衝突しました。
とりあえず数式を作ってみましたけど、電話番号の処理が難しいですね。 制限１：電話番号は 市外-市内-番号 の形式で必ず１つだけ入力。 制限２：国際電話や携帯電話など、特殊な電話番号は不可。 制限３：名前に 0が付く人，会社名等がない。※電話番号の始まりを0で探しているので 思いつくのはこれぐらいですが、他にもちゃんと動かない条件があるかもしれません。 その時は、やっぱり「ユ ー ザ ー 関数」の出番かもしれませんね。
A1に元データがあるとします。
・B1に =LEFT(A1,FIND("0",A1,1)-1)
・C1に =IF(ISNUMBER(MID(SUBSTITUTE(A1,B1,),12,1)*1),LEFT(SUBSTITUTE(A1,B1,),12),LEFT(SUBSTITUTE(A1,B1,),11))
・D1に =SUBSTITUTE(A1,B1&C1,)
（Yosh!）
みなさんこんばんわ。 なんやら超満員の観客席の待つステージに上っていくようで、顔がこわばってますわ。
例によって Alt+F11でVBEを開く 「挿入」→「標準モジュール」を選択 真新しい画面に下のコードをコピペ Alt＋Qでエクセルに戻る これで準備完了
仮にA列にデータが並んどるとして、B１に=yosi(a1)と入力してみておくんなはれ。 ご希望のデータが抽出されてまっしゃろ。=yosiはあなたのリングねーむですさかい 気ぃに要らなんだら何とでも変えてもろてよろしゅうおまんねんで、えぇ。 今日初めて仕事したわ、え〜気分。 ほなら...（弥太郎） ややこしから削除しました。
衝突したので前に書かしてもらいます。 弥太郎さん参考にさせてもらいます。が、これ名前しか取り出せないですよね？ 隠し玉早く出してくださいな。弥太郎先生っ Yosh!さんもすごいですね。全部数式とは！（ケン）
お〜ミステイク！ これ、名前だけしか拾い出してまへんわ。早速作り直します、はい。 なにがええ気分や、ホンマに。 チョンボの（弥太郎）
この関数大したことおまへんわ。 どないかして=yosi(a1)だけで出してやろうと気張りましたんやけど、あきまへんわ。 ギブアップ。関数２こ書くんやったら普通の関数と変わりまへんで。なんと情けない。 とりあえずC1に=yose(a1)と入れて貰わなしょうおまへんなぁ。 さっさと寝とったらよかった...。あ〜ぁ。Yosh!さんも一個IC頂だ〜い。 しょんぼり（弥太郎） ココもややこしから削除。
電話番号は色々な桁数が有ります。数式では正直難しいと思います。 そこで弥太郎さんにお願い名前は数式で何とかなりそうですが電話番号はどうなります？ 私の半導体の剥がれたICを差し上げますのでおせ〜て。（ケン） 弥太郎さんの口からギブアップの言葉聞きたくないよ〜
乱入します！ マクロです。 標準化されていないデータにはもうこの手しかないでしょう。
【準備】 シート名「TEMP」を追加して４７都道府県名をA1：A47へ作成してください。 名簿作成はシート名「Sheet1」、A1からで設定しています。 「新規シート」を挿入、「Sheet1」に名前を変更し 名簿のデータをA1から貼り付けます。 これを作業シートとしてください。
念のため元データは別シートでそのまま保持しておくことをお勧めします。 電話番号は半角の0で始まることを前提にしています。
【マクロの登録】
弥太郎さんの方法拝借 「例によって Alt+F11でVBEを開く 「挿入」→「標準モジュール」を選択 真新しい画面に下のコードをコピペ Alt＋Qでエクセルに戻る」
Sub TEST_20031206()
Dim 都道府県(1 To 47) As String
Dim MYCOUNT As Long
Dim i As Long
Dim C As Range
Worksheets("Sheet1").Activate
MYCOUNT = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
For i = 1 To 47
都道府県(i) = Worksheets("TEMP").Cells(i, 1).Value
Next i
For Each C In Worksheets("Sheet1").Range("A1:A" & MYCOUNT)
For i = 1 To 47
C.Value = Application.WorksheetFunction.Substitute(C.Value, _
都道府県(i), "," & 都道府県(i))
Next i
C.Value = Application.WorksheetFunction.Substitute(C.Value, "0", ",0", 1)
Next C
Columns("A:A").TextToColumns _
Destination:=Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
Comma:=True, _
FieldInfo:=Array(Array(1, 1), Array(2, 2), Array(3, 1))
End Sub
【マクロ実行】 上記の準備が全て済んだら、 Alt+F8（マクロ実行）でTEST_20031206を選択して「実行」です。
(KAMIYA) 【付録】都道府県一覧 行頭に半角スペースが入っているので置換などで半角スペースを 取り除いてから使用してください。
北海道 青森県 岩手県 秋田県 宮城県 山形県 福島県 茨城県 栃木県 群馬県 埼玉県 千葉県 東京都 神奈川県 山梨県 長野県 新潟県 富山県 石川県 福井県 静岡県 愛知県 岐阜県 三重県 滋賀県 京都府 大阪府 兵庫県 奈良県 和歌山県 島根県 鳥取県 岡山県 広島県 山口県 香川県 徳島県 高知県 愛媛県 福岡県 佐賀県 長崎県 大分県 熊本県 宮崎県 鹿児島県 沖縄県
うわ〜、乱入者がえらいモン置いていきよりましたがな。 昨日からマクロ付いてまんなぁ。私の地位を脅かす算段でんな。（笑い）
私の大した事無い関数（一応電話番号の０以外でも対応）を使う場合はもうアノ=yose の方は削除しておくんなはれ。代わりにC1へ=MID(C1,IEN(A1)+1,69)でOKですわ。
ケンさん、名前、電話番号、住所に三分割せよっちゅうことでっか？ 早朝から宿題出された（弥太郎）
わしゃ何勘違いしとったんやろ、これ、初めから３分割せよと言う設問でッかぁ？ アレまあ...。 冴えに冴えてる（弥太郎）
お待たせしました、ケンさん。 これでどないやねん！
A列にデータがあるとして B列に=yosi(a1) C列に=tel(a1) D列に=MID(C1,(LEN(H1)+LEN(I1)+1),69)
どないかして２つの式にまとめようと思いましたんやけど、結局あきまへんでしたわ。 これやったらユーザー関数っちゅうていばられしまへんわ。 それに、細こう言うたら完璧ではおまへんねんで、えぇ。 誰かが、手ぇ抜け言うてましたんでな。ここらへんで手ぇ打っときましたんで、アラ 探したらあきまへんでぇ。にっこり（笑）。 ほなら、アラ探してみてんか、言い訳用意しとるから（弥太郎） これもアラサガサレンウチに×。
>一番問題なのは、ユーザー関数にしても、それを作った人が どっか行っちゃったら、ブラックボックスになることです。 それは言えまんなぁ。 そのうち「このユーザー関数はどんな働きをするんですか？」っちゅうようなスレが 登場するかも知れまへんわ。
それといつかのスレにおましたように、やたら作ってしまうとそれこそどれがどれやら さっぱり分からんようになってしもうて、定義づけにやっきにならなアカン羽目に陥る やもしれまへんしなぁ。せいぜい２、３個に留めとくべきかもでんな。 ほな...（弥太郎）
こんにちは再び乱入者です。 昨晩は「マクロしかありません」なんて書いてしまいましたが、 一晩寝て冷静になってみると、気がつきました。 ワークシート関数と区切り位置の調整しか使ってないんですよね。「あれ」。 マクロじゃなくてもできるんじゃないだろうか？
作業シートを用意して
A2:Aｎへリストを張り付け。
B1に「'0」と入力、C1:AW1に都道府県名を入力。 B2へ
=SUBSTITUTE(A2,B$1,CHAR(44)&B$1,1)
としてコピー、 B2:AW2 へ貼り付け、 B2:AW2を範囲選択してフィルハンドルをダブルクリック （リスト範囲へフィル）
最右端の AW2:AWn をコピー、適当なセルへ値貼り付け、 貼り付け後、「データ」→「区切り位置」
「カンマやタブなどの・・・」にチェックして「次へ」 「区切り文字」で「カンマ」にチェックして「次へ」 電話番号の列を選択して「列のデータ形式」を「文字列」にして「完了」
でマクロとまったく同じ作業を標準機能でやればよいはず・・・ 作業列はいっぱい使いますが、使っている数式は一つ。
発言を訂正します。
「マクロじゃなくてもできます」
教訓。 ラブレターとVBコードはは深夜に書いてはいけない。 乱入終わり。
(KAMIYA)
ユーザー関数でセミコロンを挿入します。 =sep(A1)とか使います。 あとは値をコピペして、区切り位置でやってくらはい。 仕事中につき、未検証。 （ramrun）
Function sep(ByVal data As String) As String
Dim n As Integer
Dim ct As String, ca As Integer
Dim flg As Integer
data = StrConv(data, vbNarrow)
flg = 0
For n = 1 To Len(data)
ct = Mid(data, n, 1)
ca = Abs(AscW(ct))
If flg = 0 And 48 <= ca And ca <= 57 Then
sep = sep & ";" & ct
flg = 1
ElseIf flg = 1 And ca > 57 Then
sep = sep & ";" & ct
flg = 2
Else
sep = sep & ct
End If
Next n
End Function
大御所様の後塵を拝しまして。 田舎の電話、携帯電話にも対応してございます。 如何なものでしょうか。 「文字列３分割コンペ 参加業者」（弥太郎kk）
'------------------------------------ これは、まあまあやけど新製品に比べたら落ちるんで削除 '------------------------------------ 同じく×
みなさん有難う御座います。今日は出張でお礼が遅くなりました。 今から皆さんの方法を試してみたいと思います。（ケン）
>仕事中につき、未検証。 未検証の報い。 多摩川充;066-392-2238静;岡県横川市 何で静岡だけ？未だ全部の県ははやってまへんけど...。 未検証の検証者（弥太郎）
へへぇ〜 私が悪ぅございました。お代官様。 差し替えてやっておくんなせぇ。
こんどはちょっとだけ、確認しやしたぜ（おぃ）。 ほんとはユーザー関数にもう1つ引数を持たせて、 1なら名前、2なら電話、3なら住所を返すようにしようかと思ったけど、 それはケン坊にまかせます。
（ramrun）帰ろう〜
Function sep(ByVal data As String) As String
Dim n As Integer
Dim ct As String, ca As Integer
Dim flg As Integer
data = StrConv(data, vbNarrow)
flg = 0
For n = 1 To Len(data)
ct = Mid(data, n, 1)
ca = AscW(ct)
If flg = 0 And 48 <= ca And ca <= 57 Then
sep = sep & ";" & ct
flg = 1
ElseIf flg = 1 And (ca < 45 Or 57 < ca) Then
sep = sep & ";" & ct
flg = 2
Else
sep = sep & ct
End If
Next n
End Function
ヴォ〜！宿題が出てる！よ〜しガンバろっと。（ケン）
必死に考えましたが、いい方法が思いつかず自分の無知さにがっかりだ〜！
全然進歩のない答えですが・・・
Function sep(ByVal data As String, typ As Integer) As String
Dim n, i As Integer
Dim ct As String, ca As Integer
Dim flg As Integer
data = StrConv(data, vbNarrow)
flg = 0
For n = 1 To Len(data)
ct = Mid(data, n, 1)
ca = AscW(ct)
If flg = 0 And 48 <= ca And ca <= 57 Then Exit For
Next n
For i = n To Len(data) - n
ct = Mid(data, i, 1)
ca = AscW(ct)
If flg = 0 And 48 <= ca And ca <= 57 Then
flg = 1
ElseIf flg = 1 And (ca < 45 Or 57 < ca) Then
Exit For
End If
Next i
If typ = 1 Then
sep = Left(data, n - 1)
ElseIf typ = 2 Then
sep = Mid(data, n, i - n)
ElseIf typ = 3 Then
sep = Mid(data, i, Len(data) + 1)
End If
End Function
他には今の私の知識のすべてを試しましたがダメでした。相当試したのですが・・・
でも、StrConv、Ascはためになりました〜m(_ _)m本当はiの値に納得してない〜
（ケン）
もっと簡単に考えてくるかと思ってたけど、 なかなかチャレンジャーだね。 では簡単バージョン。
A1にデータがあるときにB1に =sep($A1,COLUMN()-1) C1,D1へドラッグした後、そのままフィルハンドルをダブルクリック。
Function sep(ByVal data As String, typ As Integer) As String
Dim n As Integer
Dim ct As String, ca As Integer
Dim flg As Integer
data = StrConv(data, vbNarrow)
flg = 0
For n = 1 To Len(data)
ct = Mid(data, n, 1)
ca = AscW(ct)
If flg = 0 And 48 <= ca And ca <= 57 Then
sep = sep & ";" & ct
flg = 1
ElseIf flg = 1 And (ca < 45 Or 57 < ca) Then
sep = sep & ";" & ct
flg = 2
Else
sep = sep & ct
End If
Next n
Select Case typ
Case 1
sep = Mid(sep, 1, InStr(1, sep, ";", vbTextCompare) - 1)
Case 2
sep = Mid(sep, InStr(1, sep, ";", vbTextCompare) + 1, _
InStrRev(sep, ";", , vbTextCompare) - 1 - InStr(1, sep, ";", vbTextCompare))
Case 3
sep = Mid(sep, InStrRev(sep, ";", , vbTextCompare) + 1, 100)
Case Else
End Select
End Function
ケン坊のならこれでいいかな。 まだ条件がよく読み取れてないようだけど、 80点あげよう。 （ramrun）
Function sep(ByVal data As String, typ As Integer) As String Dim n, i As Integer Dim ct As String, ca As Integer data = StrConv(data, vbNarrow)
For n = 1 To Len(data)
ct = Mid(data, n, 1)
ca = AscW(ct)
If 48 <= ca And ca <= 57 Then Exit For
Next n
For i = n To Len(data)
ct = Mid(data, i, 1)
ca = AscW(ct)
If ca < 45 Or 57 < ca Then
Exit For
End If
Next i
If typ = 1 Then
sep = Left(data, n - 1)
ElseIf typ = 2 Then
sep = Mid(data, n, i - n)
ElseIf typ = 3 Then
sep = Mid(data, i, Len(data) + 1)
End If
End Function
やっとイメージしとったやつがでけました。 もう前のんはややこしくなるから消しときまっせえ。
Alt+F11でVBEを開く Sheet1を選択 F7でシートモジュールを開く Private Sub Worksheet_.... っちゅうコードをコピペ
「挿入」→「標準モジュール」を選択 真新しい画面に下の test のコードをコピペ Alt＋Qでエクセルに戻る これで準備完了
後は出力したいセルに yosi と入力しておくんなはれ。
メッセージボックスのＯＫをクリックすると、ほ〜ら、出てきまっしゃろ？
どないでっか？気にいってくれました？ Explictで確認済み
ほな...（弥太郎）
親方〜っ。AutoFitの複数の列をするばあい、Columns("A:I")と言った案配やなしに
Columns(3:5)と列番で指定する事はでけしまへんのんでっか？
'--------------------
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Target.Value = "yosi" Then
test
End If
Application.EnableEvents = True
End Sub
'------------------------
Sub test()
Dim t As String, j As String, data As String
Dim tc As Integer, nc As Integer, x As Integer, b As Integer, i As Integer
Dim tr As Long, nr As Long, p As Long
Dim n
t = InputBox("どのセルのデータから始めますか？")
If Range(t) = "" Then
MsgBox "セルの選択が間違っています"
Exit Sub
End If
MsgBox "yosiのセルから右へ 「名前」 「TEL No」 「住所」でよろしいか？"
On Error Resume Next
If ActiveCell.Value <> "yosi" Then
ActiveCell.Offset(-1, 0).Activate
End If
j = ActiveCell.Address
tr = Range(t).Row
tc = Range(t).Column
nr = Range(j).Row
nc = Range(j).Column
n = ""
For p = tr To Cells(tr, tc).End(xlDown).Row
data = Cells(p, tc)
data = StrConv(data, vbNarrow)
x = Len(data)
For i = 2 To x
n = Mid(data, i, 1) * 1
If n <> "" Then
Cells(nr, nc) = Left(data, i - 1)
n = ""
For b = i + 1 To x
n = Mid(data, b, 1) * 1
If n = "" Then
n = Mid(data, b, 1)
If n <> "-" Then
Cells(nr, nc + 1) = Mid(data, i, b - i)
Cells(nr, nc + 2) = Mid(data, b, 69)
nr = nr + 1
Exit For
End If
End If
n = ""
Next b
Exit For
End If
If Cells(nr, nc + 2) <> "" Then Exit For
Next i
n = ""
Next p
On Error GoTo 0
ActiveSheet.Columns(Chr(64 + nc) & ":" & Chr(64 + nc + 2)).AutoFit
End Sub
>複数の列をするばあい、Columns("A:I")と言った案配やなしに列番で指定する
えぇ〜い。女々しいキャツめ。ダメなもんはダメなんやっ（笑）。 しゃーないなぁ。 これでDoや。
ActiveSheet.Columns(Chr(64 + nc) & ":" & Chr(64 + nc + 2)).AutoFit
どうせならSheet1に限定しないほうがいいと思いますた。 （ramrun）
ヒャッホ〜ッ、デンキュウ! とれとれの知識、早速上のコードに適用しますた。（アレ？最近舌の回りがおかしくな てきたナ） >どうせならSheet1に限定しないほうがいいと思いますた 仰せの通りで...。 AscWはまだようつこうとりまへん。 もう１回、ヒャッホ〜！（弥太郎）
疲れた〜！出張終わり！お〜80点もらってる〜！そっか〜。ふむふむ。 何か、またyosiVBAがグレードアップしてる〜、ふむふむ？分からん？ 後で検証してみよ〜。とりあえず、ramrunさん、弥太郎さん、有難う御座います。 （ケン）
弥太郎さん、確認しましたで〜。列幅まで変わり、面白いですね。 有難う御座います。（ケン）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.