Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


2607 / 13646 ツリー ←次へ | 前へ→

【66918】2枚のシートを比較し同じものがあった場合その行を抽出したい あき 10/10/17(日) 3:38 質問[未読]
【66922】Re:2枚のシートを比較し同じものがあった場... teian 10/10/17(日) 8:01 発言[未読]
【66927】Re:2枚のシートを比較し同じものがあった場... あき 10/10/17(日) 21:45 お礼[未読]
【66932】Re:2枚のシートを比較し同じものがあった場... kanabun 10/10/18(月) 9:53 発言[未読]
【66935】Re:2枚のシートを比較し同じものがあった場... あき 10/10/18(月) 21:02 お礼[未読]

【66918】2枚のシートを比較し同じものがあった場...
質問  あき  - 10/10/17(日) 3:38 -

引用なし
パスワード
   すみませんが教えてください。

2枚のシートがあり、1枚目は最大502行のデータが、
2枚目は量が分からず、1000行や2000行あったりします。

1枚目のシートのB列と2枚目のシートC列に全く同じ内容の
データがある可能性があり、全く同じデータの2枚目の行を抽出したいのですが
何か良い方法はありますでしょうか?

抽出ではなく、同じものがあった場合、2枚目のD列に『ABC』という文字が
あった場合のみ『*』を表示させたいのでその方法でもいいのですが・・・。

自分で作ったものは1枚目のデータが抽出されるのですが、
2枚目のデータを抽出しようと順番を変えた途端、全く関係のないものが
抽出されてしまい困っております。

何か良い方法があればお教えくださいませ。


Dim a As Range
Dim b As Range
Dim myCell As Range
Dim mySht As Worksheet
Dim i as Long

With Worksheets
Set a=.Item("data1").Range("B1").CurrentRegion.Columns(1)
Set b=.Item("data2").Range("C1").CurrentRegion.Columns(1)
Set mySht=.Add(After:=.Item(.Count))
End With

i=0

For Each myCell In a.Cells
If WorksheetFunction.CountIf(b,myCell.Value)>0 Then
 i=i+1
 myCell.EntireRow.Copy mySht.Cells(i,1)
End If
Next

Set a=Nothing
Set b=Nothing
Set myCell=Nothing
Set mySht=Nothing

どうぞ助言宜しくお願い致します

【66922】Re:2枚のシートを比較し同じものがあった...
発言  teian  - 10/10/17(日) 8:01 -

引用なし
パスワード
   >2枚目のデータを抽出しようと順番を変えた途端
を、どうやったのかが良く分かりませんけど、

CurrentRegionプロパティによるデータ範囲の取得で正しくいとした範囲が取得できているなら、
パッと見ですが、
>For Each myCell In a.Cells
>If WorksheetFunction.CountIf(b,myCell.Value)>0 Then

For Each myCell In b.Cells
  If WorksheetFunction.CountIf(a,myCell.Value)>0 Then
ってことかと思いましたが、違いますか?

あと、なんとなくですが、
ヘッダー行を挿入して、フィルターオプションの設定でやらせても良さそうな気もします。

【66927】Re:2枚のシートを比較し同じものがあった...
お礼  あき  - 10/10/17(日) 21:45 -

引用なし
パスワード
   助言ありがとうございます。
明日早速試してみたいと思います。

【66932】Re:2枚のシートを比較し同じものがあった...
発言  kanabun  - 10/10/18(月) 9:53 -

引用なし
パスワード
   ▼あき さん:

Loopは不要です。

teian さんがおっしゃってるように、
> フィルターオプションの設定でやらせても良さそうな気もします。

2枚目のシートに対して、1枚目のシートのB列を【検索条件範囲】として
フィルタオプションを実行すればいいのです。
もちろん、1行目は列見出しが書いてあって、
1枚目のB列の見出しと 2枚目の(フィルタ抽出するシートの)C列の見出しは
一致している必要がありますけど。

あと、
> Set a = .Item("data1").Range("B1").CurrentRegion.Columns(1)
> Set b = .Item("data2").Range("C1").CurrentRegion.Columns(1)
はまずくないですか?
各シートとも「A列にも」データがはいってるとすると、
> .Range("B1").CurrentRegion.Columns(1)
では、結局A列が取得されてしまうことになりませんか?

Sub Try1()
 Dim a As Range
 Dim b As Range
 Dim mySht As Worksheet
 
 With Worksheets
  Set a = .Item("data1").Range("B1").CurrentRegion.Columns(2) 'B列
  Set b = .Item("data2").Range("A1").CurrentRegion
  Set mySht = .Add(After:=.Item(.Count))
 End With
 If a.Cells(1).Value <> b.Item(1, 3).Value Then
   MsgBox "比較する2列の列見出しは同じでなければなりません"
   Exit Sub
 End If

 b.AdvancedFilter xlFilterCopy, a, mySht.Range("A1")
 
End Sub

【66935】Re:2枚のシートを比較し同じものがあった...
お礼  あき  - 10/10/18(月) 21:02 -

引用なし
パスワード
   ありがとうございます。
無事に作成することが出来ました。

フィルタオプションの方は、検索条件範囲が変動するので
(10行だったり100行だったり)上手く使えませんでしたが
VBAの方で無事に出来ました。
ありがとうございました。

2607 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free