![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?e8efa67)
マクロを変更したいのですが上手く、出来ません。
どなたか、教えて頂けないでしょうか?
「ユーザマスタ照合」と、「ユーザマスタ」のシートが有ります。
「ユーザマスタ照合」はA~T列で9000行位、「ユーザマスタ」はA~AI列で8000行位までデータが入っています。
両シート共に1行目は項目が入っていて、データは2行目以降になります。
「ユーザマスタ照合」のB列の「社員番号」と、「ユーザマスタ」のE列の「社員番号」が一致したら、「ユーザマスタ照合」のV列以降に「ユーザマスタ」のA~AI列データをコピーして貼り付ける。
「ユーザマスタ照合」に有って、「ユーザマスタ」無いもの(一致しないもの)はV列以降は空欄になります。また、「ユーザマスタ照合」に無く、「ユーザマスタ」だけに有るものは表示されない(コピーされない)仕様になっています。両シート共に「社員番号」の重複はありません。
※ここまでの作業は下記のマクロで作業を行っています。
追加したいのは現行は「ユーザマスタ照合」に無く、「ユーザマスタ」だけに有るものは表示されない(コピーされない)仕様になっているので「ユーザマスタ照合」と「ユーザマスタ」が一致しない「ユーザマスタ」はV列以降のユーザマスタの一番下に表示される(コピーされる)様にしたいと思っています。
お手数をお掛け致しますが宜しくお願い致します。
Sub ユーザマスタ照合()
Dim r1 As Range, r2 As Range, rf As Range
Set r1 = Worksheets("ユーザマスタ照合").Range("B:B")
With Worksheets("ユーザマスタ")
.Range("A1:AI1").Copy Worksheets("ユーザマスタ照合").Range("V1")
For Each r2 In .Range("E2", .Cells(Rows.Count, "E").End(xlUp))
Set rf = r1.Find(What:=r2.Value, After:=r1.Cells(r1.Rows.Count), LookIn:=xlValues, LookAt:=xlWhole)
If Not rf Is Nothing Then _
r2.Offset(, -4).Resize(, 35).Copy rf.Range("U1")
Next
End With
"Set r1 = Nothing"
Set rf = Nothing
End Sub
![「2つのシートの任意のセルの番号が一致した」の質問画像](http://oshiete.xgoo.jp/_/bucket/oshietegoo/images/media/f/543210968_649037df46908/M.png)
A 回答 (2件)
- 最新から表示
- 回答順に表示
No.2
- 回答日時:
下記のように修正しました。
Public Sub ユーザマスタ照合()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim dicT As Object
Dim row1 As Long
Dim row2 As Long
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim key As Variant
Set ws1 = Worksheets("ユーザマスタ")
Set ws2 = Worksheets("ユーザマスタ照合")
maxrow1 = ws1.Cells(Rows.Count, "E").End(xlUp).Row
maxrow2 = ws2.Cells(Rows.Count, "B").End(xlUp).Row
ws2.Columns("V:BD").ClearContents
ws2.Rows(maxrow2 + 1 & ":" & Rows.Count).ClearContents
ws2.Range("V1").Resize(1, 35).Value = ws1.Range("A1").Resize(1, 35).Value
Set dicT = CreateObject("Scripting.Dictionary")
For row1 = 2 To maxrow1
key = ws1.Cells(row1, "E").Value
dicT(key) = row1
Next
For row2 = 2 To maxrow2
key = ws2.Cells(row2, "B").Value
If dicT.exists(key) = True Then
row1 = dicT(key)
ws2.Cells(row2, "V").Resize(1, 35).Value = ws1.Cells(row1, "A").Resize(1, 35).Value
dicT.Remove (key)
End If
Next
row2 = maxrow2 + 1
For Each key In dicT.Keys
row1 = dicT(key)
ws2.Cells(row2, "V").Resize(1, 35).Value = ws1.Cells(row1, "A").Resize(1, 35).Value
row2 = row2 + 1
Next
MsgBox ("完了")
End Sub
No.1
- 回答日時:
こんばんは
>ここまでの作業は下記のマクロで作業を行っています。
できているのなら、似た様なことを行えばよいだけですので・・
多少効率が悪いですが、ほぼ同じことをもう一度行えば良いのではないでしょうか?
ご提示のコードでは、
>If Not rf Is Nothing Then
に該当するもの(=照合して同じ番号が存在する)行をコピペしていますが、
追加するのは、
If rf Is Nothing Then
に該当する行(=同じ番号が存在しない)を順にコピペしてゆけば宜しいかと。
(条件判断と、コピペの部分だけ変えれば良い)
2回同じ走査をするのは若干効率が悪いので、
If rf Is Nothing Then
' 同一番号が存在しない場合の処理
Else
' 同一番号が存在する場合の処理
End If
のようにまとめて分岐で処理するようにしてしまえば、1回の走査で済ますことが可能ですね。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) VBA でvlookup エラーなどは削除したい 8 2022/12/30 04:03
- Excel(エクセル) IFERROR、SMALL関数について 2 2022/08/22 23:40
- Excel(エクセル) Excel関数 情報引用する方法 4 2022/07/31 20:59
- Excel(エクセル) vba userformで漢字を全角カタカナに 2 2022/07/24 15:38
- Visual Basic(VBA) VBAで最新のデータを別シートに転記する方法をお教えください。 3 2022/04/07 19:20
- Visual Basic(VBA) access count数を変数に格納 2 2022/03/30 19:21
- Visual Basic(VBA) vbaを早くしたい 5 2022/09/09 10:58
- Visual Basic(VBA) VBA 最終行まで数式をコピーする 3 2023/01/03 15:44
- Excel(エクセル) 指定文字列が該当するA列をアクティブセルにするには 3 2022/08/17 13:18
- Visual Basic(VBA) 【ご教示ください】VBAの記述方法がわかりません。 2 2022/08/12 21:28
このQ&Aを見た人はこんなQ&Aも見ています
-
性格の違いは生まれた順番で決まる?長男長女・中間子・末っ子・一人っ子の性格の傾向
同じ環境で生まれ育っても、生まれ順で性格は違うものなのだろうか。家庭教育研究家の田宮由美さんに教えてもらった。
-
excel VBA 2つのシートの特定の列を比較して同じ値のセルがあったらその行を上書きしたい
Excel(エクセル)
-
vba 2つの条件が一致したらコピーして別シートに値のみ貼り付け
Visual Basic(VBA)
-
【VBA】特定の値が入った行をコピーして別シートに貼り付ける方法をおしえていただきたいです。
Excel(エクセル)
-
-
4
基礎的な質問なのですが、Excel VBAで、B列、C列、それぞれの値を照合し、D列へ照合結果(一致
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
B列の最終行までA列をオート...
-
Worksheets メソッドは失敗しま...
-
Excelで、あるセルの値に応じて...
-
文字列の結合を空白行まで実行
-
vba 2つの条件が一致したら...
-
【VBA】2つのシートの値を比較...
-
マクロ 最終列をコピーして最終...
-
Cellsのかっこの中はどっちが行...
-
エクセルVBAで『A列』に新...
-
URLのリンク切れをマクロを使っ...
-
VBAを使って検索したセルをコピ...
-
VBAで、離れた複数の列に対して...
-
VBAコンボボックスで選択した値...
-
VBA 値と一致した行の一部の列...
-
vba 数値がゼロになるまで引く
-
二つのリストを比べて部分一致...
-
VBAで文字列を結合
-
基礎的な質問なのですが、Excel...
-
VBマクロ 色の付いたセルを...
-
IIF関数の使い方
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Worksheets メソッドは失敗しま...
-
Excelで、あるセルの値に応じて...
-
B列の最終行までA列をオート...
-
vba 2つの条件が一致したら...
-
Cellsのかっこの中はどっちが行...
-
マクロ 最終列をコピーして最終...
-
VBAを使って検索したセルをコピ...
-
データグリッドビューの一番最...
-
URLのリンク切れをマクロを使っ...
-
VBAのFind関数で結合セルを検索...
-
【VBA】2つのシートの値を比較...
-
文字列の結合を空白行まで実行
-
IIF関数の使い方
-
Excel(M365) Vlookup/セル反転(...
-
VBA指定行削除
-
VBAでのリスト不一致抽出について
-
C# dataGridViewの値だけクリア
-
Changeイベントでの複数セルの...
-
VBAで、特定の文字より後を削除...
-
rowsとcolsの意味
おすすめ情報