いつもお世話になっております。

質問

いつもお世話になっております。

エクセル、ＶＢＡに関する質問です。

●　行削除について

ある特定の行を削除したいと考えています。

添付ファイルを参照下さい。

ある特定の列（ex B列）内データに対し紐づいている特定の列（ex A列）
が専用（紐付⇒１）（ex７８１１０に対しＡＢＣが１データ紐付いている）
の場合は、行を削除せず。

逆に、ある特定の列（ex B列）内データに対し紐づいている特定の列（ex A列）
が共通（紐付⇒２以上）（ex 紐付⇒３。１２３１０に対しＦＢＡ、ＲＦＡ、ＧＴＣ
の３データが紐付いている）の場合は、行を削除。

という条件にて、行削除を実行したい、と考えています。
どの関数、コードを利用するかどうか。。
アイデアがまるで出てきません。

お知恵を貸してください。よろしくお願いします。

回答No.2

hananoppo · ベストアンサー

こんな感じでどうでしょう。

Sub RowsDelete()
Dim i As Long, j As Long, EndRow As Long
Dim 品番 As Long, 得意先 As String
Dim Flag As Boolean

i = 2
EndRow = Range("A1").End(xlDown).Row
Do
品番 = Cells(i, 2).Value
得意先 = Cells(i, 1).Value
Flag = False
For j = i + 1 To EndRow
If Cells(j, 2).Value = 品番 And Cells(j, 1).Value <> 得意先 Then
Flag = True
Exit For
End If
Next j
If Flag = True Then
For j = EndRow To i Step -1
If Cells(j, 2).Value = 品番 Then Rows(j).Delete
Next j
EndRow = Range("A1").End(xlDown).Row
Else
i = i + 1
End If
Loop Until i >= EndRow
End Sub

お礼

ありがとうございました。
完璧でした。

回答No.1

kagakusuki

「紐づいている」という言葉は標準的な日本語では無い様ですので、私が御質問の意味を正確に理解しているのか、自信はあまり御座いませんが、質問者様がどの様な処理をなされたいのかに関しては、添付画像のリストのパターンから、何となく解った様な気がします。
（もし、私が間違って理解していた場合には、補足等で御指摘願います）

　処でもし、質問者様の仰る様に、VBAで4行目、5行目、6行目を完全に削除してしまいますと、削除後に新たに別の得意先が、例えば、品番12310を購入(？)した場合、品番12310の行が削除されずに残る事になります。
　ですから、元データは全て残して、別Sheetに編集後のリストを表示させる様にされた方が、宜しいのではないでしょうか？
　その場合は、VBAを使わずとも、関数でも可能です。

　今仮に、元のリストがSheet1に存在していて、Sheet3のA列を作業列として使用して、Sheet2に編集後のリストを表示させるものとします。
　まず、Sheet3のA1セルに次の数式を入力して下さい。

=IF(OR(INDEX(Sheet1!$A:$A,ROWS($1:1))="",INDEX(Sheet1!$B:$B,ROWS($1:1))="",SUMPRODUCT((OFFSET(Sheet1!$A$1,,,MATCH("゜",Sheet1!$A:$A,-1))<>INDEX(Sheet1!$A:$A,ROWS($1:1)))*(OFFSET(Sheet1!$B$1,,,MATCH("゜",Sheet1!$A:$A,-1))=INDEX(Sheet1!$B:$B,ROWS($1:1))))>0),"",ROWS($1:1))

　次に、Sheet3のA1セルをコピーして、Sheet3のA2以下に、Sheet1のリストの行数を上回る行数になるまで、貼り付けて下さい。

　次に、Sheet2のA1セルに次の数式を入力して下さい。

=IF(ROWS($1:1)>COUNT(Sheet3!$A:$A),"",INDEX(Sheet1!A:A,SMALL(Sheet3!$A:$A,ROWS($1:1))))

　次に、Sheet2のA1セルをコピーして、Sheet2のB1セルに貼り付けて下さい。
　次に、Sheet2のA1～B1の範囲をコピーして、同じ列の2行目以下に、Sheet1のリストの行数を上回る行数になるまで、貼り付けて下さい。

　以上です。

お礼

大変参考になりました。
ＢＡにするか迷いました。
今後ともよろしくお願いします。