inosisi回答ポイント 110ptウォッチ

質問です

ホルダーC:\test\の中にエクセルＣＳＶの複数ファイルがあります
対象データはメールアドレスデータでＡ列の1行目からあります
c:\test\のＡ列対象データ
aaaa@docomo.ne.jp
bbbb@ezweb.ne.jp
cccc@jcom.ne.jp

このデータの中から参照で指定するドメインが含まれる
メールアドレスの行を削除するマクロをお願いします

参照で指定する削除ドメインリストはマクロ実行ファイルの
参照ファイルsheet2のＡ列の1行目から複数あります

Sheet2のＡ列参照データ
docomo.ne.jp
ezweb.ne.jp

答え
c:\test\Ａ列対象データ

cccc@jcom.ne.jp

だけが残ります

よろしくお願いします。

• はてなアカウントでログイン
• 無料ユーザー登録

ベストアンサー

• km19812011/07/22 15:03:59

  満足60pt

  これを実行してみてください

  削除結果は [Sheet3] に入れます

  Public Sub hatena()

  Dim i1, i2, i3, n1, n2 As Integer

  Dim adr As String

  Dim ss As Variant

  Dim flag As Boolean

  n1 = Worksheets("Sheet1").Range("A1").End(xlDown).Row

  n2 = Worksheets("Sheet2").Range("A1").End(xlDown).Row

  i3 = 1

  For i1 = 1 To n1

  adr = Worksheets("Sheet1").Cells(i1, 1).Value

  If (adr <> "") Then

  ss = Split(adr, "@")

  flag = False

  For i2 = 1 To n2

  If (ss(1) = Worksheets("Sheet2").Cells(i2, 1).Value) Then flag = True

  Next i2

  If (flag = False) Then

  Worksheets("Sheet3").Cells(i3, 1).Value = adr

  i3 = i3 + 1

  End If

  End If

  Next i1

  End Sub

  スター

  • inosisi 2011/07/22 17:58:57

    ありがとうございます

    結構処理速度は早い感じです。

その他の回答

• きゃづみぃ2011/07/22 15:03:15

  満足50pt

  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
  
  If Worksheets("Sheet2").Range("A1") = "" Then Exit Sub
  If Worksheets("Sheet2").Range("A2") = "" Then
      e = 1
  Else
      e = Worksheets("Sheet2").Range("A1").End(xlDown).Row
  End If
  
      
  f = Dir(p & "*." & s, vbNormal)
  
  Do While f <> ""
      Set w = Workbooks.Open(Filename:=p & f, UpdateLinks:=False, ReadOnly:=False)
      '処理対象は １番目のシートのみ。
      
      With w.Sheets(1)
          
          kg = 1          '処理終了行
          
          For gg = 1 To e
              If .Range("A1") = "" Then Exit For
          
              If .Range("A2") <> "" Then
                  kg = .Range("A1").End(xlDown).Row
              Else
                  Exit For
              End If
      
             For b = kg To 1 Step -1
                  chk = ThisWorkbook.Worksheets("Sheet2").Cells(gg, "A").Value
                  If Right(.Cells(b, "A"), Len(chk)) = chk Then
                      .Rows(b).Delete Shift:=xlUp
                  End If
             Next b
          Next gg
      End With
           
      w.Save
      w.Close
      f = Dir
  Loop
  
  Application.DisplayAlerts = True
  
  End Sub
  
  

  スター

  • inosisi 2011/07/22 18:11:47

    takntさん

    ありがとうございます

    データが多いと処理時間が問題ですね

    早くする方法はありますか？

    前回の質問の2011/07/17　09：13：45　の答えのマクロのほうが早いですね

    sheet2の参照データと同じドメインを削除しないで

    参照データ以外（残したいデータ）のデータをA列最後の行と空白あけてコピーしたら早くなりますか？（前回みたく）

    よろしくお願いします。

この質問へのコメント

• きゃづみぃ2011/07/22 20:08:48
  ぜんぜん仕様が違うからです。
  
  質問したものと 違うものを作れば 速いのは 当然でしょう。
  
• きゃづみぃ2011/07/22 20:09:57
  ちなみに 時間がかかるのは、削除する処理だと思いますね。
  
  
• inosisi2011/07/23 10:12:01
  takntさん
  申し訳ございません
  たしかに質問の内容が削除することになっています
  削除にこんなに時間がかかるとは思っていませんでした
  必要なものだけ抽出するだけのほうが良いのがわかりました
  今後はそれを念頭に質問します
  ありがとうございました

質問の情報

登録日時

2011-07-22 14:11:30

終了日時

2011-07-22 19:12:02

回答条件

1人3回まで

この質問のカテゴリ

• コンピュータ
• インターネット

この質問に含まれるキーワード

人気の質問

• この英文どうなってますか？ The boy seemed to be waiting for his mother to come.（その少年は母親が来…匿名質問者312日前
• 不定詞の形容詞的用法らしいんですけど、副詞的用法と書いたら✖️ですか？ I want to buy a book to read …匿名質問者112日前
• 日向陽葵という○V女優が好きなのですが似ている○V女優はいますか匿名質問者1日前
• 共通テストで使われるプログラミング言語は共通テスト特有の言語と聞いたのですが、受験勉強で身につけたプ…匿名質問者211日前
• 内定してほしいポケモンはいますか？匿名質問者1日前

メニュー

• 質問一覧
• カテゴリ一覧
• 無料ユーザー登録
• 人力検索はてなトップ

PC版

• お問い合わせ
• ヘルプ
• お知らせ
• はてなトップ