ここから本文です

マクロ初心者です。エクセルで複数条件でデータの抽出をしたいのですがうまくでき...

iku********さん

2012/3/1319:01:20

マクロ初心者です。エクセルで複数条件でデータの抽出をしたいのですがうまくできません。どなたか教えてください。

データはこんな感じです。
A列 B列 C列 D列 E列 F列 G列
1 商品名 売上日 曜日 部署 担当者 支店 本店
2 本 3/1 木 総務 Aさん ○
3 つくえ 3/2 金 営業 Bさん ○
4 本 3/5 月 総務 Cさん ○
5 ペン 3/6 火 総務 Dさん ○
6 本 3/6 火 総務 Dさん ○
7 紙 3/6 火 総務 Dさん ○
8 つくえ 3/7 水 営業 Eさん ○

とこんな感じでデータがあります
A列とF列とG列のデータで重複することなく項目を同じシートのI列からに抽出していきたいです。
イメージはこんな感じです。

I列 J列 K列
1 商品名 支店 本店
2 本 ○
3 つくえ ○
4 本 ○
5 ペン ○
6 紙 ○

ちなみにL列にはCOUNTA関数が入っています。(=COUNTIFS(A1:G200,I2))

Sub マクロ1()
Worksheets("Sheet1").Range("I:K").Clear
With Worksheets("sheet1")
.Range("A1:G4").Copy Worksheets("Sheet1").Range("I1")
.Range("A1:A500").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=.Range("I1:K2"), _
CopyToRange:=.Range("I2"), _
Unique:=True

End With
End Sub

上記のマクロで実行すると、表がすべて抽出されてしまいます。


説明がうまくできなくてすみません。
どなたかお分かりになる方アドバイスをいただけないでしょうか???

補足入力がうまくできていませんでした。
本店 支店の下には該当のところにどちらか ○ が入力されています。

閲覧数:
1,822
回答数:
2
お礼:
250枚

違反報告

ベストアンサーに選ばれた回答

ads********さん

2012/3/1319:23:15

Dictionaryオブジェクトを用いた一例ですが。

Sub try()
Dim myDic As Object
Dim r As Range
Dim st As String

Set myDic = CreateObject("Scripting.Dictionary")

With Worksheets("Sheet1")
.Range("I:K").Clear

For Each r In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))

st = r.Value & "_" & r.Offset(, 5).Value & "_" & r.Offset(, 6).Value

If Not myDic.Exists(st) Then myDic(st) = Array(r.Value, r.Offset(, 5).Value, r.Offset(, 6).Value)

Next

.Range("I1:K1").Value = Array("商品名", "支店", "本店")
.Range("I2").Resize(myDic.Count, 3).Value = Application.Transpose(Application.Transpose(myDic.Items))

End With

Set myDic = Nothing

End Sub

ご参考になれば。

質問した人からのコメント

2012/3/15 10:31:46

成功 早速のアドバイスありがとうございました。
お二人の方にご回答していただきましたが、私のイメージしていたものが帰って来た方がこちらでしたので選ばせていただきました。ありがとうございました。
ちなみに月が変わってシートを別にしたいときは”sheet1”の部分を毎回書き換えていくしかないのでしょうか?もしお分かりになりましたらお教えください。

ベストアンサー以外の回答

1〜1件/1件中

kyo********さん

2012/3/1401:03:25

対象がA列・F列・G列と離れた範囲の場合でアドバンスフィルタを使用する場合は、合計2回アドバンスフィルタを使用しなければならないかもしれません。内容を完全に把握したわけではありませんが、下記VBAのようなアドバンスフィルタを参考下さい。

************************************************************
Sub Sample()
Dim val, i As Long
Range("I:K").Delete
Range("A1:G" & Cells(Rows.Count, 1).End(xlUp).Row).AdvancedFilter 2, , Range("P1"), 1
Range("Q:T").Delete
Range("P1:R8").AdvancedFilter 2, , Range("I1"), 1
Range("P:R").Delete
End Sub
************************************************************

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる