人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

質問です
エクセルでA列の1行目から複数のメールアドレスのデータがあり
データは複数のCSVファイルです
この中から2種類の
@docomo.ne.jpと@ezweb.ne.jp
のドメインがついたアドレスだけを抜き出してSheet1のA列1行目からコピー貼り付ける
関数かマクロをお願いします
検索するドメインは変更できるようにお願いしますドメインは2種類で変わりません
複数のCSVファイルはc:\test\に置いてもかまいません
答え
Sheet1のA列
aaaa@docomo.ne.jp
ccc@docomo.ne.jp
bbbb@ezweb.ne.jp
eee@ezweb.ne.jp

●質問者: inosisi
●カテゴリ:コンピュータ インターネット
✍キーワード:CCC DoCoMo EZweb ne.jp test
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● きゃづみぃ
●100ポイント ベストアンサー
Sub main()
Dim p As String
'対象フォルダを指定してください。
'このフォルダに この実行用のブックは 入れないでください。

p = "C:\test\"

'処理対象となる拡張子を指定して 呼び出します。
Call jikkou(p, "csv")

End Sub


Sub jikkou(p As String, s As String)

Dim bk As Workbook
Application.DisplayAlerts = False
e = 1
'チェックしたいドメイン
chk1 = "@docomo.ne.jp"
chk2 = "@ezweb.ne.jp"

 
f = Dir(p & "*." & s, vbNormal)

Do While f <> ""
 Set w = Workbooks.Open(Filename:=p & f, UpdateLinks:=False, ReadOnly:=False)
  '処理対象は 1番目のシートのみ。
 
 With w.Sheets(1)
 
 kg = 1  '処理終了行
 
 If .Range("A2") <> "" Then
 kg = .Range("A1").End(xlDown).Row
 End If
 
 For b = 1 To kg
 If Right(.Cells(b, "A"), Len(chk1)) = chk1 Then
 Cells(e, "A") = .Cells(b, "A")
 e = e + 1
 End If
 
 If Right(.Cells(b, "A"), Len(chk2)) = chk2 Then
 Cells(e, "A") = .Cells(b, "A")
 e = e + 1
 End If
 Next b
 End With
 
 w.Save
 w.Close
 f = Dir
Loop

Application.DisplayAlerts = True

End Sub

◎質問者からの返答

ありがとうございます

今テストしてみたのですが最初のCSVファイルに該当するドメインアドレスを

他のファイルから切り取って貼り付けているみたいですがあっていますか

最終の答えのやり方を教えてください

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ