質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
CSV

CSV(Comma-Separated Values)はコンマで区切られた明白なテキスト値のリストです。もしくは、そのフォーマットでひとつ以上のリストを含むファイルを指します。

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

1回答

1040閲覧

Excelのセルから読み取って会社名,メルアドのCsvファイルを作りたい

masatsutsui

総合スコア16

CSV

CSV(Comma-Separated Values)はコンマで区切られた明白なテキスト値のリストです。もしくは、そのフォーマットでひとつ以上のリストを含むファイルを指します。

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2019/04/22 21:52

編集2019/04/23 01:43

テキストExcelの「記録」シートにでA列からD列に、順に以下のような記録があります。
1の例 2018/11/5 会社名 名前 012-321-3521メルアド
2の例 2018/11/6 会社名 名前 0852-99-4123faxは5123メルアド
3の例 2018/11/7 会社名 名前 0852-99-4123名前FAXは0852-99-4122メルアド携帯番号

電話番号とメルアドは自由に配置されています。
メルアドはアルファベットから始まっているようです。
Excel Vbaで、様々なこれらから、
会社名,名前,012-321-3521,メルアド のCsvファイル「メルアド」を作り、
Outlook2016にインポートしたいです。
最低でも会社名,メルアドのCsvファイルを作りたいです。
よろしくお願いいたします。イメージ説明

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

papinianus

2019/04/22 22:18

markdownで表を書くか、わからなければエクセルのスクリーンショットを貼り付けしていただけませんか?
guest

回答1

0

ベストアンサー

正規表現を使えばある程度は抽出可能かと思います。
以下は別シートに出力する例です。
電話番号は4列目の先頭のものを抽出、メールアドレスは4列目の後方のものを抽出するようにしています。
提示されている例には対応できているかと思いますが、これ以外のフォーマットになると調整が必要です。

VBA

1Sub test() 2 Dim RE 3 Dim r As Long 4 5 Set RE = CreateObject("VBScript.RegExp") 6 Set srcsh = ActiveSheet 7 Set newsh = Worksheets.Add 8 r = 1 9 10 While srcsh.Cells(r, 1) <> "" 11 ' 会社名 12 newsh.Cells(r, 1).Value = srcsh.Cells(r, 2).Value 13 ' 名前 14 newsh.Cells(r, 2).Value = srcsh.Cells(r, 3).Value 15 ' 電話番号 16 With RE 17 .Pattern = "^(0\d+-\d+-\d+)" 18 .Global = True 19 Set reMatch = .Execute(srcsh.Cells(r, 4).Value) 20 End With 21 If reMatch.Count > 0 Then 22 If reMatch(0).SubMatches.Count > 0 Then 23 newsh.Cells(r, 3).Value = reMatch(0).SubMatches(0) 24 End If 25 End If 26 ' メールアドレス 27 With RE 28 .Pattern = "([A-Za-z][\w-]+@[\w-]+.[\w-.]+).*$" 29 .Global = True 30 Set reMatch = .Execute(srcsh.Cells(r, 4).Value) 31 End With 32 If reMatch.Count > 0 Then 33 If reMatch(0).SubMatches.Count > 0 Then 34 newsh.Cells(r, 4).Value = reMatch(0).SubMatches(0) 35 End If 36 End If 37 r = r + 1 38 DoEvents 39 Wend 40 Set RE = Nothing 41 42End Sub 43

投稿2019/04/23 02:22

ttyp03

総合スコア16996

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

masatsutsui

2019/04/23 05:33

ありがとうございました。一発でテストが成功しました。 本番も上手くいきました。ちょっと条件にヒットしないのもありますが、手作業で終わらせました。 本当に感謝いたします。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問