以下のような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.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様のコードも是非参考にさせていただき、今後の勉強に使用させて頂きます。
ありがとうございました!
お二人とも、またお力添え頂ければ幸いです。
今後ともどうぞ宜しくお願い申し上げます。
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様に教えて頂いた通り追記しただけで、あっという間に解決してしまいました!まさに求めていたご返答です!急ぎで必要だったため、今回はそちらで解決させて頂きましたが、書いて頂いたサンプルコードも是非参考にさせて頂きたいと思っております。
本当にありがとうございました!
お探しの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も見ています
-
プロが教えるわが家の防犯対策術!
ホームセキュリティのプロが、家庭の防犯対策を真剣に考える 2組のご夫婦へ実際の防犯対策術をご紹介!どうすれば家と家族を守れるのかを教えます!
-
エクセル 重複したデータを別シートに抽出させる
Excel(エクセル)
-
複数のシートに重複する文字列の抽出
Excel(エクセル)
-
VBA 列全体を別シートの列と比較し、同じ値がある行の、右端に値をコピーする方法について
Excel(エクセル)
-
-
4
excel VBA 2つのシートの特定の列を比較して同じ値のセルがあったらその行を上書きしたい
Excel(エクセル)
-
5
EXCELで2列を参照し、重複するものを横に並べたい
Excel(エクセル)
-
6
ExcelのVBAのマクロで他のシートの複数項目をクリアする方法
Visual Basic(VBA)
-
7
EXCEL VBA セルに既に入力されている文字に文字を追加する
Excel(エクセル)
-
8
VBA 別シートの同じ日付の欄に値を貼付け
Excel(エクセル)
-
9
Excelで2つのデータの突合せをしたいです
Excel(エクセル)
-
10
【VBA】特定の範囲で同じ値を含むセルの色を変える
その他(Microsoft Office)
-
11
ある列のセルに特定の文字が入っていたら他のセルに決まった文字を入れる
Word(ワード)
-
12
vba 2つの条件が一致したらコピーして別シートに値のみ貼り付け
Visual Basic(VBA)
-
13
【Excel VBA】指定行以降をクリアするには?
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルのワークシートが重く...
-
エクセルで入力シートから別シ...
-
Excelの中央値の複数条件について
-
Excel VBAを使った重複行の抜き...
-
エクセル シフト勤務表から、...
-
Excel 複数のシートからグラフ...
-
VBA セルの値と同じ名前のシー...
-
エクセルVBA:表の内容を担当者...
-
ExcelVBAで、指定したシートに...
-
エクセル マクロを使って日々...
-
IF, ISNUMBER, INDIRECTの組み...
-
VBAのoffsetの動き方について教...
-
質問:特定文字列から空白行ま...
-
エクセル 毎日更新する表のデ...
-
Excelの選択肢をポップアップリ...
-
ピボットテーブルから抽出デー...
-
2つ条件である文字の値を参照し...
-
Excelで数値→文字列変換で指数...
-
テキストボックス内の文字のふ...
-
Excelで行ごとコピー、同じ行を...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで入力シートから別シ...
-
VBA セルの値と同じ名前のシー...
-
Excel 複数のシートからグラフ...
-
ExcelVBAで、指定したシートに...
-
Excelの中央値の複数条件について
-
Excel ハイパーリンク先のセル...
-
IF, ISNUMBER, INDIRECTの組み...
-
エクセルのワークシートが重く...
-
VBAでシート名をセルから取得し...
-
エクセルで入力→日付を自動判別...
-
質問:特定文字列から空白行ま...
-
エクセル自動の年月
-
エクセル シフト勤務表から、...
-
エクセル マクロを使って日々...
-
VBAのoffsetの動き方について教...
-
エクセルVBA:表の内容を担当者...
-
Excel日付変更との参照先の連動
-
EXCEL VBA 一致しないデータの...
-
エクセルについて質問です 日付...
-
Excelの選択肢をポップアップリ...
おすすめ情報