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

重複行のデータの結合と削除について

投稿者 : 斉藤     投稿日時 : 2016/12/16(Fri) 22:55:31     OS : 未指定     EXCEL : 未指定
お世話になります。
会社でとあるデータを扱っているのですが、手処理が大変なのでなんとかしたいと考えています。

A~Qまでの列に各項目があり、全体で8000件弱のデータがあります。
1行目は見出しとなっています。

A列に6桁の番号があり、ソートされていない状態で、また部分的に重複があります。
重複は無いものもありますが、多いと10件以上重複しています。
重複しているデータのA~Pまでの列の情報は、すべて同じ情報です。

Q列には文字列があるので、重複しているデータはQ列のみカンマ区切りで結合し、
重複のない状態でこれを別のシートに、1行目は見出し付で表示させたいと思っています。

VBAで処理したいと考えていますが、結合の辺りで分からなくて途方に暮れています。
お助け頂けると、本当に助かります。
どうかよろしくお願い致します!

[返信 1] Re : 重複行のデータの結合と削除について
投稿者 : 斉藤     投稿日時 : 2016/12/17(Sat) 09:54:11
こちらマルチで投稿したため、申し訳ありませんでした。
解決しそうなので取り下げさせて頂きます。

ありがとうございました

[返信 2] Re : 重複行のデータの結合と削除について
投稿者 : 管理人     投稿日時 : 2016/12/17(Sat) 17:23:22
質問を取り下げるということですが、
このような自動化のお話はよくあることなので、
掲示板に履歴を残す意味でサンプルコードを載せておきます。

重複データの処理方法はいろいろあると思いますが、
以下のサンプルコードはディクショナリオブジェクト(連想配列)を使った例になります。

Sub macro1()

Dim ws As Worksheet
Dim row As Long
Dim dco As Object

Dim key As String
Dim firstRow As Long
Dim concatCol As Integer
Dim delcnt As Long


' 処理中の画面描画抑止
Application.ScreenUpdating = False

' データのあるシート名を設定
Set ws = Worksheets("Sheet1")

' ディクショナリオブジェクト作成
Set dco = CreateObject("Scripting.Dictionary")

' 重複時のデータ結合カラム(Q列は17)
concatCol = 17

' 明細開始行
row = 2

' 削除カウント初期化
delcnt = 0



' 明細開始行からA列の番号が空白になるまでループ
Do Until ws.Cells(row, 1).Value = ""

' A列をキーとする
key = ws.Cells(row, 1).Value


If dco.Exists(key) Then
' 重複している最初の行を辞書から取得
firstRow = dco(key)

' Q列をカンマ区切りで結合
ws.Cells(firstRow, concatCol).Value = _
ws.Cells(firstRow, concatCol).Value & _
"," & _
ws.Cells(row, concatCol).Value


' 行削除
ws.Rows(row).Delete

' カウント数カウントアップ
delcnt = delcnt + 1

' ※行削除した場合は row をカウントアップしてはいけない

Else
' 新規番号のため行番号を辞書登録
dco.Add key, row

' 処理行カウントアップ
row = row + 1
End If

Loop


Application.ScreenUpdating = True


' 処理結果表示
If delcnt = 0 Then
MsgBox "重複行はありませんでした。", vbInformation
Else
MsgBox delcnt & "行削除しました。", vbInformation
End If

End Sub

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

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


( 処理日時 : 2019-08-26 09:56:22 )

Page
Top