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

Question

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

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

●　行削除について

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

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

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

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

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

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

hananoppo · Accepted Answer

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

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

kagakusuki · Answer

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

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

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

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング