![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?5a7ff87)
以下のような2シートから、重複する「商品番号」のあるsheet1の行を抜き出して、別シートに書き出したいと思っております。
sheet1
| A | B | C
-+--------+-------+-----
1| | |
-+--------+------+--------
2|商品番号|商品名|責任者
-+--------+------+--------
3| 123456| ガム|山田太郎
-+--------+------+--------
4| 2345678| チョコ|田中花子
・・・
sheet2
| A | B | C
-+--------+-------+-----
1| | |
-+--------+------+--------
2|商品番号|商品名|責任者
-+--------+------+--------
3| 3987624| |
-+--------+------+--------
4| 193678| |
・・・
そこでVBAを作成したのですが、例えば商品番号「222011001」の行を抜き出したいのに、「22011001」の行も一緒に抜き出してしまいます。
どこがいけないのか、教えて頂けないでしょうか。
作成したVBAは以下の通りです。
VBA初心者で本を見ながら作ったため、大変見にくくなっているかと思います。申し訳ありませんが、どなたかおわかりになる方がいらっしゃいましたら、どうぞ宜しくお願い致します。
Option Base 1
Option Explicit
Sub 重複データ抽出書き直し()
Dim シート(2) As Worksheet
Dim 比較列(2) As Integer
Dim 一致セル As Range
Dim 検索範囲 As Range
Dim i As Integer
Set シート(1) = Sheets("sheet1")
Set シート(2) = Sheets("sheet2")
比較列(1) = 1: 比較列(2) = 1
シート(2).Activate
ActiveCell.CurrentRegion.Select
Selection.Offset(1, 比較列(2) - 1) _
.Resize(Selection.Rows.Count - 1, 1) _
.Select
Set 検索範囲 = Selection
Sheets.Add After:=Sheets(Sheets.Count)
シート(1).Activate
ActiveCell.CurrentRegion.Select
Selection.Resize(1).Copy
With Sheets(Sheets.Count).Range("A1")
If Application.Version >= 9 Then
.PasteSpecial 8
End If
.PasteSpecial
End With
For i = 2 To Selection.Rows.Count
Set 一致セル = 検索範囲.Find(Selection.Cells(i, 比較列(1)).Value)
If Not 一致セル Is Nothing Then
Selection.Offset(i - 1).Resize(1) _
.Copy Sheets(Sheets.Count) _
.Range("A65536").End(xlUp) _
.Offset(1)
End If
Next i
Sheets(Sheets.Count).Activate
End Sub
No.2ベストアンサー
- 回答日時:
こんにちは。
初心者とお書きになっていますが、他のプログラミング言語をおやりになっていますね。ただ、Excel VBAでは、使わないような方法がいくつもあります。VBAは、個人的なもので、なおかつ結果オーライですから、それに関しては、余計なお世話になってしまいますが、かなり入り組んだスキルが混じっている内容だと思います。特に、他人に見せる場合は、なるべく、オーソドックスなスタイルにしたほうがよいです。
個々の問題点ですが、
>例えば商品番号「222011001」の行を抜き出したいのに、「22011001」の行も一緒に抜き出してしまいます。
>一致セル = 検索範囲.Find(Selection.Cells(i, 比較列(1)).Value)
Find メソッドは、必要な引数は必ず入れてください。ワークシート(Excel)のメソッドは、VBAの概念とは違う仕様を持っていますので、使用する場合は気をつけたほうがよいです。デフォルトがデフォルトでないこともあります。
Set 一致セル = 検索範囲.Find(Selection.Cells(i, 比較列(1)).Value,)
↓
Set 一致セル = 検索範囲.Find(Selection.Cells(i, 比較列(1)).Value, , , xlWhole)
もしも、Excel97を意識しているなら、いっそ、Application.Match(検索値,範囲,0)やCountIfを使ったほうがよいと思います。
それから、オブジェクトは、一般的には、配列にはしないで、Collectionにします。しかし、数が少ない場合は、個々に変数に代入します。
サンプルコード:
以下は、新しくペーストされるシートの重複も避けるように作られています。(以下の、Application.ワークシート関数は、古いスタイルの書き方です)
Sub getDoubledItems()
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim NewSh As Worksheet
Dim ret As Integer
Dim i As Long
Dim col As Integer
Set Sh1 = Worksheets("Sheet1")
Set Sh2 = Worksheets("Sheet2")
Set NewSh = Worksheets.Add(After:=Sheets(Sheets.Count))
col = Sh1.Range("A2").CurrentRegion.Columns.Count
Sh1.Range("A2").Resize(, col).Copy NewSh.Range("A1")
'ここにセル幅の調整用のコードを入れます。
Application.ScreenUpdating = False
With Sh1
For i = 3 To .Range("A65536").End(xlUp).Row
ret = Application.CountIf(Sh2.Columns(1), .Cells(i, 1).Value)
If ret > 0 Then
If Application.CountIf(NewSh.Columns(1), .Cells(i, 1).Value) = 0 Then
.Cells(i, 1).Resize(, col).Copy NewSh.Range("A65536").End(xlUp).Offset(1)
End If
End If
Next i
End With
Application.ScreenUpdating = True
Set Sh1 = Nothing: Set Sh2 = Nothing: Set NewSh = Nothing
End Sub
ご回答頂き、ありがとうございました!
こんなに早くお返事を頂き恐縮です。
他のプログラミング言語に関してもちょっとかじった程度なので、Excelの本を読みながら頭の中で色々なものがごちゃまぜになって困っていた次第です・・・。
Excel97に対する記述も、あればいざという時便利なのかなという程度で、実際に使用しているのは2002なのです。欲張りすぎました(笑)。
findの部分について、Wendy02様に教えて頂いた通り追記しただけで、あっという間に解決してしまいました!まさに求めていたご返答です!急ぎで必要だったため、今回はそちらで解決させて頂きましたが、書いて頂いたサンプルコードも是非参考にさせて頂きたいと思っております。
本当にありがとうございました!
No.1
- 回答日時:
こんにちは。
まず、検索範囲の設定が間違いましたので、
以下のようにマクロを変えて見ました。如何でしょうか。
Option Explicit
Sub 重複データ抽出書き直し()
Dim Range1 As Range
Dim Range2 As Range
Dim mRow As Long
Dim c1 As Range
Dim c2 As Range
Dim wR As Long
Dim シート(3) As Worksheet
Sheets.Add After:=Sheets(Sheets.Count)
Set シート(3) = ActiveSheet
Set シート(1) = Sheets("sheet1")
Set シート(2) = Sheets("sheet2")
mRow = シート(1).Range("A" & Rows.Count).End(xlUp).Row
Set Range1 = シート(1).Range("A1:A" & mRow)
mRow = シート(2).Range("A" & Rows.Count).End(xlUp).Row
Set Range2 = シート(2).Range("A1:A" & mRow)
シート(3).Activate
wR = 0
For Each c1 In Range1
For Each c2 In Range2
If c2.Value = c1.Value Then
wR = wR + 1
シート(1).Rows(c1.Row).Copy
シート(3).Rows(wR).Select
シート(3).Paste
End If
Next
Next
End Sub
ご回答頂き、ありがとうございました!
こんなに早くお返事を頂き恐縮です。
Excelのマクロに関して不慣れなもので、本を見ながらなんとなくわかったつもりで書いていたため、自分でも仕組みがよくわかっていない関数を多用していました・・。
Wendy02様が書いてくださったコードが「私の作成したコードに合わせて書いてくださったもの」ならば、pkh4989様が書いてくださったコードは「初心者の私にもわかりやすいスタイルで書いてくださったもの」なのではないかと感じております。どのような処理をしている部分なのかということが、コードを見ていてわかりやすかったです。
同じ処理をおこなうにも、色々な方法があるのだなということを実感いたしました。
今回は急ぎだったためWendy02様の回答を参考にさせて頂いたということで、ポイントをこのようにさせて頂きましたが、気持ちはお二人ともに20pt差し上げたい!と感謝いたしております。
最初にご回答頂きましたのに、申し訳ございません。
pkh4989様のコードも是非参考にさせていただき、今後の勉強に使用させて頂きます。
ありがとうございました!
お二人とも、またお力添え頂ければ幸いです。
今後ともどうぞ宜しくお願い申し上げます。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) ExcelVBAでDo Until loopのネスト、IF文を使って一致する物と一致しない物としたい 11 2022/12/24 17:46
- Visual Basic(VBA) 形式を選択して貼り付け 以下のコードで「元」シートと「先」シートのA列に同じ値があったら指定範囲をコ 5 2022/11/11 07:30
- Visual Basic(VBA) オブジェクトが見つかりません 1 2023/06/24 19:43
- Visual Basic(VBA) まとめシートから集計シートへA列のコードが一致したら1行コピーするマクロをネット上で見つけました。こ 1 2022/08/30 14:11
- Excel(エクセル) 日付で矢印マクロ 4 2023/07/25 16:47
- Visual Basic(VBA) VBA 請求書自動作成 3 2022/04/24 01:58
- Visual Basic(VBA) excel vbaでvlooupの変数がわかりません。 7 2022/05/30 09:35
- Excel(エクセル) マクロで行を追加、削除すると行位置がずれますが、解決方法はありませんか?。 5 2022/05/28 16:03
- Visual Basic(VBA) このVBAでExcelアプリケーションを作成は必要ですか? 3 2023/07/19 21:13
- Excel(エクセル) マクロで最終行から上に検索を逆にしたい 1 2022/05/17 18:27
このQ&Aを見た人はこんなQ&Aも見ています
-
プロが教える店舗&オフィスのセキュリティ対策術
中・小規模の店舗やオフィスのセキュリティセキュリティ対策について、プロにどう対策すべきか 何を注意すべきかを教えていただきました!
-
エクセル 重複したデータを別シートに抽出させる
Excel(エクセル)
-
VBA 別シートの同じ日付の欄に値を貼付け
Excel(エクセル)
-
vba 2つの条件が一致したらコピーして別シートに値のみ貼り付け
Visual Basic(VBA)
-
-
4
エクセル:複数シートで重複データを抽出したい
Excel(エクセル)
-
5
EXCELで2列を参照し、重複するものを横に並べたい
Excel(エクセル)
-
6
ExcelのVBAのマクロで他のシートの複数項目をクリアする方法
Visual Basic(VBA)
-
7
【VBA】特定の範囲で同じ値を含むセルの色を変える
その他(Microsoft Office)
-
8
複数のシートに重複する文字列の抽出
Excel(エクセル)
-
9
VBA 列全体を別シートの列と比較し、同じ値がある行の、右端に値をコピーする方法について
Excel(エクセル)
-
10
excel vbaで日付一致の行にデータ転記
Excel(エクセル)
-
11
エクセルVBA:リストに登録した単語と一致する文字色のみを、変更する方法
Excel(エクセル)
-
12
VBAでの重複データに色付け
Visual Basic(VBA)
-
13
【Excel VBA】指定行以降をクリアするには?
Visual Basic(VBA)
-
14
excel VBA 2つのシートの特定の列を比較して同じ値のセルがあったらその行を上書きしたい
Excel(エクセル)
-
15
【VBA】2つのシートの値を比較して条件一致したら、同じ行の隣の値を別ブックへ転記したいです。 VB
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelの中央値の複数条件について
-
VBA セルの値と同じ名前のシー...
-
エクセルで入力シートから別シ...
-
Excel 複数のシートからグラフ...
-
エクセル シフト勤務表から、...
-
ExcelVBAで、指定したシートに...
-
VBAでシート名をセルから取得し...
-
エクセルで別シートから一つの...
-
エクセルVBA:表の内容を担当者...
-
Excel ハイパーリンク先のセル...
-
エクセルで検索した場所へ自動...
-
エクセルVBAで元のシート上の特...
-
エクセル:入力内容を別シート...
-
質問:特定文字列から空白行ま...
-
テキストボックス内の文字のふ...
-
Excelで数値→文字列変換で指数...
-
エクセルでグラフタイトルが折...
-
Excelで行ごとコピー、同じ行を...
-
エクセル 指定した文字列を含...
-
塗りつぶしの色をコピーするには
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで入力シートから別シ...
-
Excel 複数のシートからグラフ...
-
Excelの中央値の複数条件について
-
エクセル シフト勤務表から、...
-
IF, ISNUMBER, INDIRECTの組み...
-
エクセルのワークシートが重く...
-
ExcelVBAで、指定したシートに...
-
VBA セルの値と同じ名前のシー...
-
Excel ハイパーリンク先のセル...
-
エクセル自動の年月
-
VBAのoffsetの動き方について教...
-
エクセルで入力→日付を自動判別...
-
エクセルVBA:表の内容を担当者...
-
エクセル マクロを使って日々...
-
エクセルについて質問です 日付...
-
ピボットテーブルから抽出デー...
-
VBAでシート名をセルから取得し...
-
Excelの選択肢をポップアップリ...
-
VBAを利用しオートフィルタで日...
-
Excel日付変更との参照先の連動
おすすめ情報