• ベストアンサー

リストから重複行を削除して貼り付けるとき...

  Range("D6:D37").AdvancedFilter Action:=xlFilterCopy, _ copytorange:=Sheets("集計").Range("c2"), unique:=True  以上のようなマクロを実行させたとき,D6~D37のセルの中に  空白行もあり,リストをシート「集計」のC2のセルに貼り付けた  結果をみてみると,空白も貼り付けられています。  この空白を除いて貼り付ける方法をご教授していただけたらと思います。

質問者が選んだベストアンサー

  • ベストアンサー
  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.2

No1です。 こちらに差し替えてください。 Sub TEST01() Dim Rng As Range With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Set Rng = Range("D6:D37") ActiveSheet.AutoFilterMode = False With Rng .AutoFilter .AutoFilter Field:=1, Criteria1:="<>" .SpecialCells(xlCellTypeVisible).Copy End With ActiveSheet.AutoFilterMode = False With Sheets("集計") .Range("IV2").PasteSpecial Application.CutCopyMode = False .Range("IV2", .Range("IV2").End(xlDown)).AdvancedFilter _ Action:=xlFilterCopy, CopyToRange:=.Range("C2"), Unique:=True .Range("IV2", .Range("IV2").End(xlDown)).ClearContents End With With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With Set Rng = Nothing End Sub

その他の回答 (2)

  • CHRONOS_0
  • ベストアンサー率54% (457/838)
回答No.3

ジャンプのセル選択を使えば値のあるセルだけを選択できますね Sub Macro() Range("D6:D37").Select Selection.SpecialCells(xlCellTypeConstants, 23).Select Selection.Copy Sheets("集計").Select Range("C2").Select ActiveSheet.Paste End Sub

  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.1

リストのRange("D6:D37")と、貼り付け先のSheets("集計")は別のシートなんですね? Sub TEST() With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Set Rng = Range("D6:D37") ActiveSheet.AutoFilterMode = False With Rng .AutoFilter .AutoFilter Field:=1, Criteria1:="<>" .SpecialCells(xlCellTypeVisible).Copy End With ActiveSheet.AutoFilterMode = False With Sheets("集計") .Range("IV2").PasteSpecial Application.CutCopyMode = False .Range("IV2", .Range("IV2").End(xlDown)).AdvancedFilter _ Action:=xlFilterCopy, CopyToRange:=.Range("C2"), Unique:=True .Range("IV2", .Range("IV2").End(xlDown)).ClearContents End With With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With これでどうでしょうか?

関連するQ&A

  • 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 不勉強で申し訳ありませんが、どなたかご回答いただければ幸いです。

  • excelでAdvancedFilterを使って重複データを削除したい。

    初心者質問で申し訳ありません。 重複データを削除したいんですが、調べたところ AdvancedFilterを使って・・・とのことでした。 Sheets("コピー元sheet").Range("範囲").AdvancedFilter _ Action:=xlFilterCopy, _ CopyToRange:=Sheets("コピー先sheet名 ").Range("範囲"), _ Unique:=True ということは分かったのですが、「どの項目の重複 を削除したいのか?」というのはどこで指定するのでしょうか・・・。(例:B列の「部署」という項目の列で重複している部署があったらデータを削除したい・・・等) 例文が見苦しかったらごめんなさい!!!

  • 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を使って条件範囲をするにはどうしたらいいのでしょうか? よろしくお願いします。

  • inputboxではセル番地が指定できず困っています。

    EXCEL2000のVBAで、フィルターオプション機能を自動化したいのですが、 抽出先が変動するので、inputboxでセル番地を選択しようとすると、セルを選択することができず、自分で「A1」などと入力すると、きちんとA1に抽出結果が出てくるのですが、自分でセル番地をinputboxに入力するのではなく、マウスでセル番地を指定したいのですが、どのような方法をすればよかったでしょうか? よろしくお願いします。ちなみ作ったVBAは以下のとおりです。(複数の表から同じ条件で抽出し、inputboxで指定したセル番地に抽出結果を出し、その右側に続けて抽出結果を貼り付けていくという感じで作っています) Sub 抽出() Dim Shouhin1 As String Dim Shouhin2 As String Dim Shouhin3 As String Shouhin1 = InputBox("抽出先を指定してください") Shouhin2 = "d" & Mid(Shouhin1, 2, 5)’二つ目の表の抽出先を指定 Shouhin3 = "g" & Mid(Shouhin1, 2, 5)’3つ目の表の抽出先を指定 Sheets("抽出先").Select Sheets("データ").Range("A5:c44").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("データ").Range("B1:B2"), CopyToRange:=Range(Shouhin1), _ Unique:=False Sheets("データ").Select Sheets("抽出先").Select Sheets("データ").Range("d5:f44").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("データ").Range("B1:B2"), CopyToRange:=Range(Shouhin2), _ Unique:=False Sheets("データ").Select Sheets("抽出先").Select Sheets("データ").Range("g5:i44").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("データ").Range("B1:B2"), CopyToRange:=Range(Shouhin3), _ Unique:=False End Sub

  • エクセル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代引き金額 へ書き出ししているのですが、もう少し処理が早く出来る提案はありますでしょうか? 問題なく動いてはいるのですが、少し処理に時間がかかってしまう為、簡単な方法があるかご質問させて頂きました。 皆様の知恵をお貸しください。

  • EXCELマクロ セルに入力したシート名から参照

    よろしくお願いします。 複数のシートがあり、それぞれ 1109,1110,1111,1112,1201,1202,1203,1204,1205 と名前がついています。 それぞれのシートには月毎のデータが入っています。 Sub Macro1() Columns("F:J").Select Selection.ClearContents Sheets("1205").Columns("A:E").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("C4:E5"), CopyToRange:=Range("F2:J2"), Unique:=False End Sub ↑のマクロをSheet3で作りましたが、4行目の「Sheets("1205")」の1205の部分を可変で作れればと 思っています。Sheet3のC3セル内に入力したシート名(1109や1203等)でフィルタ出来ると助かります。 どうぞよろしくお願いします。

  • マクロで実行時1004エラーがでます・・

    Application.CommandBars("Picture").Visible = False Range("D3").Select Selection.AutoFilter Range("D6").Select Range("B4:L360").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("D2:E3"), CopyToRange:=Range("B5:L50"), Unique:= _ False Range("N20").Select End Sub どこが悪いのでしょうか? まったく未経験者なので、わかりません。。よろしくお願いします。

  • マクロのフィルター機能を使って

    マクロのフィルター機能を使って”Unique:=True”、重複するデータから 別のシートに重複しないようにデータを抽出使用としているのですが シートに書き込んだ際になぜか最初のデータだけが重複データとして残っています。 いろいろ試してみたんですが、よく分かりません。 以下のコマンドが、実際のものです。 Range("A3:A65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Sheet1").Range("A2"), Unique:=True データとしては、以下のようなものです。 A 1 項目 2 番号 3 STUG1208 4 STUG1208 5 STUG1208 6 STUG1209 7 STUG1210 8 STUG1207 9 STUG1206 10 STUG1208 11 STUG1202 12 STUG1204 よろしくお願いします。

  • エクセル フィルタオプションについて

    教えて下さい。 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

専門家に質問してみよう