ID非公開

2021/4/14 4:27

22回答

マクロコードについてご教示ください。

Visual Basic | Excel30閲覧xmlns="http://www.w3.org/2000/svg">500

ベストアンサー

0
画像

ThanksImg質問者からのお礼コメント

ありがとうございました! 一番回答早くて、画像まで付けていただき分かりやすかった方をベストアンサーとさせていただきました!

お礼日時:4/17 20:07

その他の回答(1件)

0

一覧・削除・変更はID順にソートされます。 一覧・削除・変更とも1行目は項目行で、データは2行目からとします。 Dim LastRL, LastRC, LastRD Dim RL Dim WSL As Worksheet, WSC As Worksheet, WSD As Worksheet Dim SIDL, SIDC, SIDD Const StartR = 2 Application.ScreenUpdating = False '--各シートを変数に代入 Set WSL = Worksheets("一覧") Set WSD = Worksheets("削除") Set WSC = Worksheets("変更") '--各シートをIDでソート WSL.UsedRange.Offset(1, 0).Sort key1:=WSL.Cells(2, 2) WSC.UsedRange.Offset(1, 0).Sort key1:=WSC.Cells(2, 2) WSD.UsedRange.Offset(1, 0).Sort key1:=WSD.Cells(2, 2) '--各シートの最終入力行を取得 LastRL = WSL.Cells(Rows.Count, "B").End(xlUp).Row LastRC = WSC.Cells(Rows.Count, "B").End(xlUp).Row LastRD = WSD.Cells(Rows.Count, "B").End(xlUp).Row '--一覧を最終行から(削除行があるので)検索 For RL = LastRL To StartR Step -1     '--IDを取得     SIDL = WSL.Cells(RL, 2)     '--変更を調べ尽してなかったら変更を調べる     If LastRC <> 1 Then         '--変更のIDを取得         SIDC = WSC.Cells(LastRC, 2)         '--既に調べた変更IDなら         If SIDL < SIDC Then             '--次の変更IDを取得             LastRC = LastRC - 1             SIDC = WSC.Cells(LastRC, 2)         End If         '--IDが一致したら         If SIDL = SIDC Then             '--行ごと変更             WSC.Rows(LastRC).Copy WSL.Rows(RL)         End If     End If     '--削除を調べ尽してなかったら削除を調べる     If LastRD <> 1 Then         '--削除のIDを取得         SIDD = WSD.Cells(LastRD, 2)         '--既に調べた削除IDなら         If SIDL < SIDD Then             '--次の削除IDを取得             LastRD = LastRD - 1             SIDD = WSD.Cells(LastRD, 2)         End If         '--IDが一致したら         If SIDL = SIDD Then             '--一覧の1行を削除             WSL.Rows(RL).Delete         End If     End If Next RL Application.ScreenUpdating = True