- ベストアンサー
ＥＸＣＥＬＶＢＡで重複データを削除する方法
- ＥＸＣＥＬのＶＢＡを使用して重複データを削除する方法について質問があります。
- 具体的には、A列の日付とB列の機種が全く同じ内容であれば削除したいと考えています。
- 現在のプログラムは単列のみの照合で、複数列の照合はできないようです。どのように修正すれば良いでしょうか？
- nanami0310
- お礼率70% (76/108)
- オフィス系ソフト
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
関連するQ&A
- エクセル2007 VBAについて教えてください。
顧客情報と販売履歴をソフトからCSVで書き出してシート1とシート2へ貼り付けしてそのデータをシート3へ抽出しているのですが、もっと良い方法があれば教えてください。 顧客情報と販売履歴がソフト上の関係で別々に書き出しされる為、シート1へ顧客情報のみを貼り付けしております。シート2に販売履歴を貼り付けしております。 そのデータを別シート A納品番号 B代引金額 C略称 D客先名 E郵便番号 F住所1 G住所2 H.TEL K納品番号（A列と同じコードです）L伝票No M管理番号 N客先情報 O商品コードP商品名Q数量 R納入単価 S納入金額 T客先コード変換 U商品名半角 へ転記するようにしております。 ここで抽出ボタン（マクロ起動）すると161行目から抽出するようにしております。 Private Sub CommandButton3_Click() Range("K161").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A161:A162"), CopyToRange:=Range("K161"), Unique:=False ActiveWindow.SmallScroll Down:=9 Range("K167").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A167:A168"), CopyToRange:=Range("K167"), Unique:=False ActiveWindow.SmallScroll Down:=9 Range("K173").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A173:A174"), CopyToRange:=Range("K173"), Unique:=False ActiveWindow.SmallScroll Down:=6 Range("K179").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A179:A180"), CopyToRange:=Range("K179"), Unique:=False ActiveWindow.SmallScroll Down:=9 Range("K185").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A185:A186"), CopyToRange:=Range("K185"), Unique:=False Range("K191").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A191:A192"), CopyToRange:=Range("K191"), Unique:=False ActiveWindow.SmallScroll Down:=6 Range("K197").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A197:A198"), CopyToRange:=Range("K197"), Unique:=False ActiveWindow.SmallScroll Down:=6 Range("K203").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A203:A204"), CopyToRange:=Range("K203"), Unique:=False Range("K210").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A210:A211"), CopyToRange:=Range("K210"), Unique:=False ActiveWindow.SmallScroll Down:=9 Range("K216").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A216:A217"), CopyToRange:=Range("K216"), Unique:=False Range("K222").Select Range("K1:U149").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "A222:A223"), CopyToRange:=Range("K222"), Unique:=False そしてこのデータを転送用と言うシート A3納品番号 B3商品名1 C3商品名2 D3商品名3 E3氏名 F3郵便番号 G3住所1 H3住所2 I3住所3 J3名前2 K3電話番号 R3代引き金額 へ書き出ししているのですが、もう少し処理が早く出来る提案はありますでしょうか？ 問題なく動いてはいるのですが、少し処理に時間がかかってしまう為、簡単な方法があるかご質問させて頂きました。 皆様の知恵をお貸しください。
- ベストアンサー
- Visual Basic
- excel マクロでデータ抽出したい
excelの抽出をマクロ化しようと思っています。 キー記録で Sheets("data").Range("B11:O714").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("data").Range("G3:G5"), CopyToRange:=_ Range("B4:O615") , Unique:=False を得たので、これを元にして、条件範囲をオートシェイプのある列を条件にしようと思い、 col = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Column で、オートシェイプの列を取得し、 Sheets("data").Range("B11:O714").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("data").Range(Cells(3, col), Cells(5, col)),_ CopyToRange:=Range("B4:O615") , Unique:=False としたのですが、エラーになってしまいます。 colを使って条件範囲をするにはどうしたらいいのでしょうか？ よろしくお願いします。
- ベストアンサー
- Visual Basic
- Excel VBA 重複なしリスト作成
VBA初心者です。 よろしくお願いいたします。 重複なしリスト作成用コードを次のように入力しました。 Worksheets("Sheet 1").Columns("BF:BF").AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=Worksheets("Sheet 2").Range("A1"), Unique:=True この抽出先であるシート2のセルが常にA列の最終行の続きから入力できるようにしたいのですが、どうしたらよいでしょうか？ 下記のようなコードで試しましたがうまくいきませんでした。 Worksheets("Sheet 1").Columns("BF:BF").AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=Worksheets("Sheet 2").Range(.Cells(Rows.Count, "A").End(xlUp).Row + 1), Unique:=True 不勉強で申し訳ありませんが、どなたかご回答いただければ幸いです。
- ベストアンサー
- Visual Basic
- excelでAdvancedFilterを使って重複データを削除したい。
初心者質問で申し訳ありません。 重複データを削除したいんですが、調べたところ AdvancedFilterを使って・・・とのことでした。 Sheets("コピー元sheet").Range("範囲").AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=Sheets("コピー先sheet名 ").Range("範囲"), _ Unique:=True ということは分かったのですが、「どの項目の重複 を削除したいのか？」というのはどこで指定するのでしょうか・・・。(例：B列の「部署」という項目の列で重複している部署があったらデータを削除したい・・・等） 例文が見苦しかったらごめんなさい!!!
- ベストアンサー
- オフィス系ソフト
- excel2007VBA 二つの動作の繰り返し処理
excel2007でマクロを勉強し始めたばかりです。VBAの繰り返し処理をしたいのですが、以下のようなマクロの請求書個別発行を一括発行にしたいと考えています。繰り返し開始から、終了までを、数値がなくなるまで繰り返したい場合、どのようになるでしょうか。よろしくお願いします。 Sub 請求書個別発行() ' ' 請求書個別発行 Macro ' ' Range("A3:R24").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "売上一覧表!Criteria"), CopyToRange:=Range("W6:AN50"), Unique:=False Sheets("得意先").Select Range("C3:O90").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "得意先!Criteria"), CopyToRange:=Range("R6:AD325"), Unique:=False 繰り返し開始 Sheets("売上一覧表").Select Range("T4").Select （T4からT5,T6,T7、、、と降順に値がなくなるまで選択される。） Selection.Copy （T4＝Y4） Range("Y4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range("A3:R24").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "売上一覧表!Criteria"), CopyToRange:=Range("W6:AN50"), Unique:=False Sheets("請求書").Select Range("B16").Select （B16から、B17、B18,,,と降順に値がなくなるまで選択される。） Selection.Copy （B16=I6） Range("I6").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("請求書").Select Application.Dialogs(xlDialogPrint).Show 繰り返し終了 End Sub 以下は自分なりに考えたVBAですが、エラーになります。 Sub 請求書集計発行() ' ' 請求書発行 Macro ' ' Range("A3:R24").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "売上一覧表!Criteria"), CopyToRange:=Range("W6:AN50"), Unique:=False Sheets("得意先").Select Range("C3:O90").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "得意先!Criteria"), CopyToRange:=Range("R6:AD325"), Unique:=False Dim wst1 As Worksheet Dim wst2 As Worksheet Set wst1 = ThisWorkbook.Worksheets("売上一覧表") Set wst2 = ThisWorkbook.Worksheets("請求書") Dim i As Long Dim j As Long For i = 4 To 100 For j = 16 To 100 If wst1.Range("T" & i) <> "" And Not IsNull(wst1.Range("T" & i)) Then If wst2.Range("B" & j) <> "" And Not IsNull(wst2.Range("B" & j)) Then myrow = wst1.Cells(Rows.Count, 1).End(xlUp).Row + 1 myrow = wst2.Cells(Rows.Count, 1).End(xlUp).Row + 1 wst1.Range("T" & myrow) = wst1.Range("Y4") Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Range("A3:R24").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "売上一覧表!Criteria"), CopyToRange:=Range("W6:AN50"), Unique:=False Sheets("請求書").Select wst2.Range("B" & myrow) = wst2.Range("I6") Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("請求書").Select Application.Dialogs(xlDialogPrint).Show End If Next i Next j End Sub
- ベストアンサー
- オフィス系ソフト
- エクセル フィルタオプションについて
教えて下さい。 sheet1～sheet3まであります。 【sheet1】と【sheet2】をフィルタオプション で検索条件範囲が【記号】部分で、 【sheet3】の結果になりますが、 VBAで、どのようにすれば良いのか わかりません。 Sheets("Sheet1").Range("A1:C3").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("A1:A2"), CopyToRange:=Range("A3:C150"), Unique:=False Sheets("Sheet2").Range("A1:C6").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("A1:A2"), CopyToRange:=Range("A3:C150"), Unique:=False End Sub このプログラムで実行するとSheet2の抽出しか できません。 何が足りないのでしょうか？ 宜しくお願いします。 【sheet1】 A B C 品名 金額 記号 1 いちご 100 06-02 2 りんご 200 06-01 3 みかん 300 06-02 【sheet2】 A B C 品名 金額 記号 1 いちご 500 06-01 2 りんご 1000 06-01 3 みかん 1500 06-02 【sheet3】 A B C 1 記号 2 06-02 3 品名 金額 記号 4 いちご 100 06-02 5 みかん 300 06-02 6 みかん 1500 06-02
- 締切済み
- オフィス系ソフト
- VBAのAdvancedFilterについて with構文で囲まないとオブジェクト定義エラーになる理由
エクセルでVBAの下記コードで実行すると、実行時エラー'1004' アプリケーション定義またはオブジェクト定義のエラーとなりますが、 Worksheets("作業用").Activate Worksheets("職員").Range(Cells(6, 1), Cells(Wrow, 12)).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("a6:c8"), CopyToRange:=Range("d6:z2000"), Unique:=False それを下記のようにwith end with構文で囲むとエラーとなりません。 形式的には同じコードに見えるのですが、実質的に何が違うためオブジェクト定義エラーにならないのでしょうか。 AdvancedFilterに限らず、しばしば同様の原因によるエラーに悩まされていますので、ご教示いただければ幸いです。 Worksheets("作業用").Activate With Worksheets("職員") .Range(.Cells(6, 1), .Cells(Wrow, 12)).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("a6:c8"), CopyToRange:=Range("d6:O2000"), Unique:=False End With
- ベストアンサー
- オフィス系ソフト
- ExcelのVBAでの抽出
初心者です。よろしくお願いいたします。 sheet1の"A2"～"C6"に簡単な表を作りました。 A列に人の名前が入力されています。 そこで、A列の名前が"花子"のデータだけを抽出 してSheet2へコピーしたいのです。 そこで試行錯誤の上、下のような記述をしました。 Sub 抽出() Application.ScreenUpdating = False Sheets("sheet2").Activate Sheets("sheet2").Columns("A:C").Clear With Sheets("Sheet1") .Range("A2").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:="花子", CopyToRange:=Sheets("sheet1").Range("A2"), Unique:=False End With Application.ScreenUpdating = True End Sub しかし、うまくいきません（TT） エラー:400 とかでるんですけど なにがいけなんでしょうか・・。 他にもAdvancedFilterを使うさいに気をつけること がありましたらご指導ください。 (項目行の中のセルが統合されていたりすると うまくいかない・・・とかあるんでしょうか。) よろしくご指導ください。お願いいたします。
- ベストアンサー
- オフィス系ソフト
- EXCEL VBA 作業用シートの使い回し
データのあるシートから、一定の条件にあうデータを当初から用意した作業用シート抜き出してきた上で、抜き出したシートの１つの列にあるデータ集から重複のないデータを抜き出すため、advancedfilterを使用しています。 別のサブルーチンを作成して、同一作業用シートを使い回す形で上記の作業を実行すると、表題のみコピーしてデータをコピーしなくなる現象が生じました。 作業用シートを削除して、新たにシートを挿入して作業用シートと名前を付けて、advancedfilterを実行すると、正常に機能しました。 このような現象がおきる理由をご教示願います。 この現象を避けるには、作業用シートをサブルーチンごとに挿入・削除を繰り返す必要が生じ、処理スピードが落ちると予想されます。 よき、アドバイスがあればよろしくお願いします。 Sub フィルター() Dim rows As Double '重複を削除した番号リスト作成 With Worksheets("作業用") rows = .Range("b65536").End(xlUp).Row .Range(.Cells(6, 3), .Cells(rows, 3)).AdvancedFilter Action:=xlFilterCopy, _ copytorange:=.Range("N6"), unique:=True End With End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルＶＢＡでのフィルタオプションについて
マクロの記録を利用して、自分なりに本を参考に以下のように手直しをしてみました。 やりたいこととしては、 名前の定義で“仕入単価他”とつけてあるデータから ｓｈｅｅｔ1のＢ列に入力した内容(抽出条件）を ｓｈｅｅｔ２に抽出するということです。 ｓｈｅｅｔ１の抽出条件はＢ列に入力します。 フィルタオプションの“ＯＲ”のようになり、 抽出する条件は複数行です。(列はＢ列のみ） 以下のようなコードで実行をすると、 Ｂ列の一番最初に書いたものの内容を抽出してくるだけで、複数のデータを引っ張ってきてくれません。 いろいろと直してはみたのですが、どうしても最初の条件のみを見て抽出してしまいます。 どのように手直ししてよいのかわからなくなってしまいましたので、教えてください。 Dim 検索 As Range Dim 範囲 As Range Set 検索 = Worksheets(1).Range("B1").CurrentRegion Set 範囲 = Worksheets(1).Range("B65536").End(xlUp).Offset(5) Worksheets(1).Activate Range("仕入単価他").AdvancedFilter Action:= _ xlFilterCopy, CriteriaRange:=検索, _ CopyToRange:=Range("B65536").End(xlUp).Offset(5), Unique:=False Range("B65536").End(xlUp).CurrentRegion.Copy _ Destination:=Worksheets(2).Range("A1") End Sub
- ベストアンサー
- オフィス系ソフト
お礼
ありがとうございました！ 会社のＰＣ（Win98）ではできませんでしたが、家の（WinXP）ではできました。明日、会社でクリアの件をみてみます。 ありがとうございました。