前提・実現したいこと
<シート1>
<シート2>
図のようにB列とC列でどちらもデータが重複した場合のみ、Sheet1から二つの行データをSheet2に転記するVBAが作りたいです。
B列のみ重複チェックをしてSheet2に転記するマクロを試してみたのですが、同姓同名の方のデータも抽出されてしまったので、方法があれば教えて頂きたいです。
よろしくお願い致します。
発生している問題・エラーメッセージ
エラーメッセージ
該当のソースコード
ソースコード
試したこと
VBA初心者でどうすればよいのか分かりません。
補足情報(FW/ツールのバージョンなど)
ここにより詳細な情報を記載してください。
『B列のみ重複チェックをしてSheet2に転記するマクロ』の記載をお願いします。
Public Sub b()
Dim r1 As Double
Dim r2 As Double
Dim rLST As Double
Dim cntR As Double
Dim cntA As Double
Dim cnt As Double
Dim i As Integer
Dim pick1()
Dim pick2()
Dim colE()
'//-----シート名の指定----
Const SNM1 = "Sheet1"
Const SNM2 = "Sheet2"
'------------------------//
'//-----シート1データ開始行指定----
Const srt1 = 2
'--------------------------------//
'//-----シート2データ貼付行指定----
Const srt2 = 2
'--------------------------------//
'シート1のデータ最終行を取得
Worksheets(SNM1).Select
Worksheets(SNM1).Range("A" & srt1).Select
Selection.End(xlDown).Select
rLST = ActiveCell.Row
r1 = srt1
cntR = 1
Do Until r1 > rLST
'選択行が可視の時
If Sheets(SNM1).Rows(r1).Hidden = False Then
'B列の値が「-」かつ「---」でない時
If Worksheets(SNM1).Range("B" & r1) <> "-" And Worksheets(SNM1).Range("B" & r1) <> "---" Then
'行番号を取得
ReDim Preserve pick1(cntR)
pick1(cntR) = r1
'B列の値を取得
ReDim Preserve colE(cntR)
colE(cntR) = Range("B" & r1)
cntR = cntR + 1
End If
End If
r1 = r1 + 1
Loop
'対象行(可視&B列がハイフンでない)内でのB列重複確認
cntR = 1
For cntA = 1 To UBound(pick1)
i = 0
For cnt = 1 To UBound(colE)
If Worksheets(SNM1).Range("B" & pick1(cntA)) = colE(cnt) Then
i = i + 1
'重複が1つでもあったら比較処理を終了(時短対策)
If i > 1 Then
Exit For
End If
End If
Next
'重複の行番号を取得
If i > 1 Then
ReDim Preserve pick2(cntR)
pick2(cntR) = pick1(cntA)
cntR = cntR + 1
End If
Next
'シート2へコピペ
r2 = srt2
For cnt = 1 To UBound(pick2)
Worksheets(SNM1).Rows(pick2(cnt) & ":" & pick2(cnt)).Copy
Worksheets(SNM2).Select
Worksheets(SNM2).Rows(r2 & ":" & r2).Select
ActiveSheet.Paste
r2 = r2 + 1
Next
'アクティブセルをA1にしておく
Worksheets(SNM1).Select
Application.CutCopyMode = False
Worksheets(SNM1).Range("A1").Select
Worksheets(SNM2).Select
Worksheets(SNM2).Range("A1").Select
End Sub
こちらになります。
よろしくお願い致します。
社員IDの重複の検出では駄目な理由がありますか?
社員IDを複数持っている社員がいるので、社員IDでの重複の検出が難ししいので、氏名と生年月日で検出したいと思っております。
ソースはコメントではなく質問の編集で追加してください
回答3件
あなたの回答
tips
プレビュー