Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


59603 / 76738 ←次へ | 前へ→

【21820】Re:同じ項目行中の特定の数字を消去するには?
発言  ichinose  - 05/1/31(月) 18:17 -

引用なし
パスワード
   ▼ギン さん:
こんばんは。


>いつもお世話になっております。
>どなたかお教え下さいませ。
>ワークシート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」のC列を作業列として、使用しています。
作業列をどの列でも良いですが、その場合、コード中の数式も変更が必要です。
'=================================================================
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)
   'C列から削除セルを取得
   .Offset(0, 2).ClearContents
   If Err.Number = 0 Then ans.EntireRow.Delete
'               削除処理
   On Error GoTo 0
   End With
End Sub


手動操作をマクロにしただけですが・・・・。
確認してみて下さい。
3 hits

【21818】同じ項目行中の特定の数字を消去するには? ギン 05/1/31(月) 17:01 質問
【21820】Re:同じ項目行中の特定の数字を消去するに... ichinose 05/1/31(月) 18:17 発言
【21825】Re:同じ項目行中の特定の数字を消去するに... ギン 05/2/1(火) 11:24 質問
【21837】Re:同じ項目行中の特定の数字を消去するに... Jaka 05/2/1(火) 16:06 発言
【21841】Re:同じ項目行中の特定の数字を消去するに... ギン 05/2/1(火) 19:11 お礼
【21844】Re:同じ項目行中の特定の数字を消去するに... ichinose 05/2/1(火) 20:29 発言
【21849】Re:同じ項目行中の特定の数字を消去するに... Jaka 05/2/2(水) 9:32 発言

59603 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free