Excel VBA 質問スレッド No.43 (解決済)

上下に同じデータが有ったら、他のセルに書き出したい

投稿者 : ころりん     投稿日時 : 2018/04/13(Fri) 14:38:58     OS : Windows 10     EXCEL : その他
A列  B列   
氏名  個人No.
か    5
あ    11
さ    8
き    6
き    6
す    20

この様なデータが600件ほどあります。氏名で並び替えたので同名の人は上下に並びますが、上の氏名と下の氏名が同じで、しかも個人No.も同じであれば、そのデータを別のセルに書き出したいのです。重複データの一覧表を作りたいのですがどの様にすれば可能でしょうか?よろしくお願いいたします。。   

[返信 1] Re : 上下に同じデータが有ったら、他のセルに書き出したい
投稿者 : ころりん     投稿日時 : 2018/04/14(Sat) 10:56:59
■[質問] ころりんさん(2018-04-13 14:38:58)の記事
> A列  B列   
> 氏名  個人No.
> か    5
> あ    11
> さ    8
> き    6
> き    6
> す    20

> この様なデータが600件ほどあります。氏名で並び替えたので同名の人は上下に並びますが、上の氏名と下の氏名が同じで、しかも個人No.も同じであれば、そのデータを別のセルに書き出したいのです。重複データの一覧表を作りたいのですがどの様にすれば可能でしょうか?よろしくお願いいたします。。   

[返信 2] Re : 上下に同じデータが有ったら、他のセルに書き出したい
投稿者 : 管理人     投稿日時 : 2018/04/14(Sat) 16:19:42
A列、B列はソート済みという前提で以下のようなマクロを作ってみました。
重複データは同じシートのD列、E列の2行目以降に出力されます。


Sub sample()

' データの列
Const COL_NAME = 1
Const COL_No = 2

' 重複用データの列
Const COL_DUP_NAME = 4
Const COL_DUP_No = 5

Dim iRow As Integer
Dim iDupRow As Integer
Dim bDupFlg As Boolean

iRow = 2 ' データ明細開始行
iDupRow = 2
bDupFlg = False

Do Until Cells(iRow + 1, COL_NAME).Value = ""


If Cells(iRow, COL_NAME).Value = Cells(iRow + 1, COL_NAME).Value And _
Cells(iRow, COL_No).Value = Cells(iRow + 1, COL_No).Value Then

If Not bDupFlg Then

Cells(iDupRow, COL_DUP_NAME).Value = Cells(iRow, COL_NAME).Value
Cells(iDupRow, COL_DUP_No).Value = Cells(iRow, COL_No).Value
iDupRow = iDupRow + 1
bDupFlg = True

End If

Else

bDupFlg = False

End If


iRow = iRow + 1

Loop

MsgBox "処理が終了しました。", vbInformation

End Sub

スポンサード リンク
 
 
当掲示板について
返信入力フォーム
お 名 前  :
内  容   :
ステータス  : この質問を解決済みにする

認証コード  :
        キャプチャ画像


( 処理日時 : 2019-07-18 01:53:50 )

Page
Top