重複抽出マクロ

winxp he sp3, excel2003
AB DE: 銘柄コード（4桁固定）銘柄名　一体です。
1.やりたい事
ABとDEが、重複している場合、下記の様に、FGHに記述するマクロです。列が揃ってなくて、見にくいですが。
下記重複抽出マクロではNGです。コメントお願いします。
A B C D E F G H
3864 三菱製紙 0.15 3865 北越紙 3865 北越製紙 0.15
3865 北越製紙 0.15 4224 ロンシール 4531 有機薬 0
4530 久光製薬 0.45 4531 有機薬 7968 田崎真珠 0.15
4531 有機薬 0 4614 トウペ
4534 持田製薬 0.15 7968 田崎真珠
7958 天馬 0.15 8091 ニチモウ
7968 田崎真珠 0.15
8113 ユニチャ 0.9
8114 デサント 0.15

Sub 重複抽出()
Rows(1).Insert
Range("A1:e1").Value = [{1,2,3,4,5}]
Range("IV2").Formula = "=COUNTIF(A:A,d2)>0"
Columns("d:e").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Range("IV1:IV2"), _
CopyToRange:=Range("f1:h1")
Range("IV2").Clear
Rows(1).Delete
End Sub
よろしくお願いします。

No.3 ベストアンサー 回答者： irija_bari 回答日時： 2008/08/07 20:53

Sub 重複抽出2()

　'行1に空行を追加する
　Rows(1).Insert
　
　'セルA1～E1に値1～5を代入する
　Range("A1:E1").Value = [{1,2,3,4,5}]
　
　'列DにセルA2と同じ値があれば TRUE、無ければ FALSE
　Range("IV2").Formula = "=COUNTIF(D:D,A2)>0"
　
　'列A～Cにフィルタをかける
　'---- 以下は引数の説明 ----
　　'フィルタをかけた結果を他の場所に保存する
　　'フィルタ条件 (詳細不明)
　　'保存場所の指定
　Columns("A:C").AdvancedFilter _
　　Action:=xlFilterCopy, _
　　CriteriaRange:=Range("IV1:IV2"), _
　　CopyToRange:=Range("F1:H1")
　
　'セルIV2の式を消去する
　Range("IV2").Clear
　
　'行1を削除する
　Rows(1).Delete
End Sub

この回答へのお礼

希望通りできました。ありがとう御座いました。

お礼日時：2008/08/07 20:59

No.2 回答者： irija_bari 回答日時： 2008/08/07 19:48

「セル Ax = セル Dy」 ならば

セル Fz = セル Ax
セル Gz = セル Bx
セル Hz = セル Cx
(ただし、x, y, z は任意の整数)
という代入を実行するということですね。

NG とは？何が問題になっているか記述すべきでしょうね。
今回は「エラー 400」のようですね。
これは http://oshiete1.goo.ne.jp/kotaeru.php3?q=2211259 を参照しましょう。
おそらく列 D ～ E を列 F ～ H にコピーしようとしているのが原因ですね。
2列を3列にコピーすることはできませんから。

コードのコメントが無いと書きましたが、これは
Rows(1).Insert '行1に空の行を挿入する。
Range("A1:e1").Value = [{1,2,3,4,5}] 'セル A1 ～ E1 に 1 ～ 5 を代入する
...
のようにコードにコメント (説明文) を記述するということです。

C 列のコピーが無いバージョンはうまく動作するということなので、
それを掲載すれば手早く回答できると思います。

この回答への補足

回答　ありがとう御座います。
C列が無い場合のマクロを示します。
Sub 重複抽出4()
Rows(1).Insert
Range("A1:d1").Value = [{1,2,3,4}]
Range("IV2").Formula = "=COUNTIF(A:A,c2)>0"
Columns("C:D").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Range("IV1:IV2"), _
CopyToRange:=Range("e1:f1")
Range("IV2").Clear
Rows(1).Delete
End Sub

補足日時：2008/08/07 20:15

No.1 回答者： irija_bari 回答日時： 2008/08/07 18:16

補足要求です。

まず「やりたい事」なのですが、
「セル Ax = セル Dy」 かつ 「セル Bx = セル Ey」ならば
セル Fz = セル Ax
セル Gz = セル Bx
セル Hz = セル Cx
(ただし、x, y, z は任意の整数)
という代入を実行するということで合っているでしょうか？

コード (マクロ) の意図を読み取れませんでした。
どのような処理手順になっているかコメントを付けてくれないと理解できません。
ちなみに、私が上記のような処理を行うなら esd827 さんとは異なるコードを書きます。
(私が VBA のことを良く知らないためです。
一般的なプログラミング (例えば C 言語) でのアルゴリズムを VBA で書くことになります。)

>列が揃ってなくて、見にくいですが。
これはカンマ区切り (CSV 形式) で掲載すると良いと思います。
カンマ区切りであれば、見た目で列が揃っていなくても Excel にインポートすれば
列が揃った形で表示されます。

この回答への補足

問い合わせ　ありがとう御座います。補足説明します。
1.key　pointは、銘柄コードです。
銘柄コードが同じかどうかで、判別すればよいのです。
銘柄名は、3864 三菱製紙　or　三菱紙　となったりしますので。
尚、私のマクロは、c列が無い場合のマクロをベースにしています。実績有り。
2.今後、カンマ区切り (CSV 形式) で掲載します。

よろしくお願いします。

補足日時：2008/08/07 18:32