fork download
  1. Option Explicit
  2.  
  3. Public Sub 指定行削除()
  4. Dim ws1 As Worksheet '対象項目
  5. Dim ws2 As Worksheet '対象シート
  6. Dim lastRow1 As Long '対象項目 最終行
  7. Dim lastRow2 As Long '対象シート 最終行
  8. Dim row1 As Long '対象項目 行番号
  9. Dim row2 As Long '対象シート 行番号
  10. Dim del_dict As Object '削除対象のキー(種類No)
  11. Dim undel_dict As Object '削除対象外のキー(種類No+名称No)
  12. Dim key1 As String '種類No
  13. Dim key2 As String '種類No+名称No
  14. Set ws1 = Worksheets("対象項目")
  15. Set ws2 = Worksheets("対象シート")
  16. Set del_dict = CreateObject("Scripting.Dictionary")
  17. Set undel_dict = CreateObject("Scripting.Dictionary")
  18. lastRow1 = ws1.Cells(Rows.count, "A").End(xlUp).Row '対象項目の最終行取得
  19. lastRow2 = ws2.Cells(Rows.count, "A").End(xlUp).Row '対象シートの最終行取得
  20. '対象項目を最終行まで検索
  21. For row1 = 3 To lastRow1
  22. '種類Noが空白でないなら
  23. If ws1.Cells(row1, "A").Value <> "" Then
  24. '種類Noを削除対象のキーとする
  25. key1 = ws1.Cells(row1, "A").Value
  26. del_dict(key1) = True
  27. '名称Noが空白でないなら、種類No+名称Noを削除対象外のキーとする
  28. If ws1.Cells(row1, "C").Value <> "" Then
  29. key2 = key1 & "|" & ws1.Cells(row1, "C").Value
  30. undel_dict(key2) = True
  31. End If
  32. End If
  33. Next
  34. '対象シートを最終行から2行まで処理する
  35. For row2 = lastRow2 To 2 Step -1
  36. key1 = ws2.Cells(row2, "A").Value
  37. key2 = key1 & "|" & ws2.Cells(row2, "C").Value
  38. '種類Noが削除対象となっていて
  39. If del_dict.exists(key1) = True Then
  40. '種類No+名称Noが削除対象外となっていないなら
  41. If undel_dict.exists(key2) = False Then
  42. '当該行を削除する
  43. ws2.Rows(row2).Delete
  44. End If
  45. End If
  46. Next
  47. MsgBox ("完了")
  48. End Sub
  49.  
Not running #stdin #stdout 0s 0KB
stdin
Standard input is empty
stdout
Standard output is empty