重複したデータの内、最新データを残して古いデータの一部だけを抽出して保管したい。

試行錯誤の末に燃え尽きてしまったので、お力を借りたく思い質問させて頂きました。

参考画像のような表にデータを入力するマクロを導入したは良いものの、ID（C列）の情報が重複した際のデータの保管方法に困っています。
最新のデータの後方（I列以降全て）に前回に使用した日付（A列）のデータを保管していきたいと思っています。また、過去のI列以降のデータも全て引き継いで保管したいと考えています。
イメージとして参考画像の矢印の様にデータを移して行きたいです（黄色で塗りつぶされている列は古いデータな為削除致します。）

聡明な回答者様のお力添えを心よりお待ちしております。
出来ればコピペしてそのまま使えるようなマクロを頂けると本当に助かります！！
宜しくお願いします。

sazi

2021/05/19 06:00 編集

履歴は持たずに過去使用日だけ追加していけばいいんじゃないでしょうか。そうすれば、引き継ぎなどの処理を考えずに、過去使用日の横のスライド程度で済みますから。

Yamasan2525

2021/05/19 06:32

返信頂きありがとうございます！取り扱ってるデータの性質上、データの履歴を残していないと不便なんですよね… ですので、できれば残す方向で考えております！

行動規範の内容に同意します

回答3件

ベストアンサー

動かしていませんが、私ならこんなふうにします。

VBA
1Sub Main()
2
3Dim i As Long
4Dim j As Long
5Dim k As Long
6
7With ActiveSheet
8
9For i = 2 To .UsedRange.Rows.Count
10    DoEvents
11    If .Range("C" & i).Value = "" Then
12        Exit For
13    Else
14        For j = 2 To .UsedRange.Rows.Count
15            DoEvents
16            If .Range("C" & i).Value = "" Then
17                Exit For
18            ElseIf .Range("C" & i).Value = .Range("C" & j).Value Then
19                .Range("I" & j).Value = .Range("A" & i).Value
20                
21                For k = 9 To .UsedRange.Columns.Count
22                    DoEvents
23                    If .Cells(i, k).Value = "" Then
24                        Exit For
25                    Else
26                        .Cells(j, k + 1).Value = .Cells(i, k).Value
27                    End If
28                Next k
29            End If
30        Next j
31    End If
32Next i
33
34End With
35
36End Sub

投稿2021/05/19 10:34

plomte

総合スコア46

試してないけど、雰囲気こんな感じでどうでしょうか。

VBA
1    Dim dic As New Scripting.Dictionary
2    Dim i, wID
3    For i = 2 To 16
4        wID = Cells(i, 3).Value
5        If dic.Exists(wID) Then
6            arr = Split(dic(wID), vbTab)
7            Cells(i, 9).Resize(, UBound(arr) + 1).Value = arr
8            dic(wID) = Cells(i, 1).Value & vbTab & dic(wID)
9        Else
10            dic(wID) = Cells(i, 1).Value
11        End If
12    Next
13