| |
▼ギン さん：
こんばんは。
>いつもお世話になっております。
>どなたかお教え下さいませ。
>ワークシートAの中に削除したい品名と数があります
>ワークシートA
>列A 列B
>品名A 200
>品名B 150
>品名C 350
↑このシートのシート名を「A」とします。
>ワークシートBの中には同一品名で数が数パターンあります
>（ワークシートと同一品名で同一数のものは必ずあります）
>ワークシートB
>列A 列B
>品名A 20
>品名A 200←
>品名A 150
>品名B 150←
>品名B 25
>品名C 350←
>品名C 34
↑このシートのシート名を「B」とします。
例題どおり、この「A」も「B」の1行目からデータが入っているとしましょう。
以下のコードは、シート「B」のＣ列を作業列として、使用しています。
作業列をどの列でも良いですが、その場合、コード中の数式も変更が必要です。
'=================================================================
Sub main()
Dim rnga As Range
Dim rngb As Range
Dim Aadd As String
Dim Badd As String
With Worksheets("A")
Set rnga = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
Aadd = rnga.Address(, , xlR1C1, True)
Badd = rnga.Offset(0, 1).Address(, , xlR1C1, True)
End With
'↑シート「A」のデータ範囲の取得
With Worksheets("B")
Set rngb = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
' ↑シート「B」のデータ範囲の取得
With rngb
.Offset(0, 2).Formula = "=IF(SUMPRODUCT((" & Aadd & "=rc[-2])*(" & _
Badd & "=rc[-1]))=1,true,"""")"
'↑シート「A」のリストデータと等しいものがあれば、「True」をセット
On Error Resume Next
Set ans = .Resize(, 3).SpecialCells(xlCellTypeFormulas, xlLogical)
'Ｃ列から削除セルを取得
.Offset(0, 2).ClearContents
If Err.Number = 0 Then ans.EntireRow.Delete
' 削除処理
On Error GoTo 0
End With
End Sub
手動操作をマクロにしただけですが・・・・。
確認してみて下さい。
|
|
ichinose
- 05/1/31(月) 18:17 -
