[[20220623122541]]　『分類１で重複した行を条件を指定して削除したい』（さかえ）　ページの最後に飛ぶ

『分類１で重複した行を条件を指定して削除したい』（さかえ）

３つの条件を指定して行を削除できますでしょうか？
条件１：分類１が重複
条件２：分類２が重複
条件３：個数が少ない

品名＿＿個数＿＿分類１＿＿分類２
砂糖　　3 　　　調味料　　雑貨
コーヒー 4 　　　嗜好　　　雑貨
みかん　4 　　フルーツ　　柑橘
夏みかん 2 　　フルーツ　　柑橘
メロン　3 　　フルーツ　　果物
菜っ葉　6 　　　野菜　　　葉物
ジャガイモ2 　　野菜　　　根菜

＜使用 Excel：Office365、使用 OS：Windows10 ＞

 _|____A_____|___B____|___C____|___D____|___E____
 1|品名      |個数    |分類１  |分類２  |        
 2|砂糖      |       3|調味料  |雑貨    | FALSE   =IF(COUNTIFS(C:C,C2,D:D,D2)>1,B2)
 3|コーヒー  |       4|嗜好    |雑貨    | FALSE  
 4|みかん    |       4|フルーツ|柑橘    |       4
 5|夏みかん  |       2|フルーツ|柑橘    |       2 ← 個数が少ない
 6|メロン    |       3|フルーツ|果物    | FALSE                   尚、消すのは手動で...
 7|菜っ葉    |       6|野菜    |葉物    | FALSE  
 8|ジャガイモ|       2|野菜    |根菜    | FALSE

（白茶） 2022/06/23(木) 13:13

自動で行を消したいので調べたら下記コードの事例がありましたので試してみたのですが、これだと３列目の重複しか見てくれません。複数条件として４列目の重複と２列目の大小を付け加えるにはどのようなコード修正をしたらよろしいでしょうか？

Dim MR As Long
Dim MC As Long
Dim DP As Long
MR = Cells(Rows.Count, 1).End(xlUp).Row '最終行,A:A
MC = Cells(1, Columns.Count).End(xlToLeft).Column '1:1,最終列
DP = 3

    Range(Cells(1, 1), Cells(MR, MC)).Sort _
    Key1:=Cells(1, DP), Order1:=xlAscending, _
    Header:=xlYes

    Dim j As Long
    With Cells(2, DP)
        For j = .CurrentRegion.Rows.Count To 1 Step -1
            If .Offset(j, 0) = .Offset(j - 1, 0) Then .Offset(j, 0).EntireRow.Delete
        Next j
    End With
（さかえ） 2022/06/23(木) 14:09

 >条件３：個数が少ない
 これは「最も少なかった行」という解釈でOKか?
 また、複数行該当した場合の措置は?

 とりあえず、
 そこは明確になさった方が宜しいかと思われます。

（白茶） 2022/06/23(木) 16:03

[[20220623154528]]
（ちょ） 2022/06/23(木) 17:31

 あらら。そうでしたか。
 んじゃ、私はこれで御暇します。

    Sub せっかくなのでCOUNTIFS使ってみたよ()
        Dim d As Range, v As Variant, i As Long, t As Range
        Set d = Intersect([A:D], [A1].CurrentRegion)
        If d.Rows.Count < 3 Then Exit Sub
        With d.Columns(d.Columns.Count + 1).Resize(, 2)
            .Columns(1).FormulaR1C1 = "=IF(COUNTIFS(C[-2],RC[-2],C[-1],RC[-1])>1,RC[-3])"
            .Columns(2).FormulaR1C1 = "=RC[-1]=MIN(C[-1])"
            v = .Columns(2).Value
            .Clear
        End With
        For i = 2 To d.Rows.Count
            If v(i, 1) Then If t Is Nothing Then Set t = d.Rows(i) Else Set t = Union(t, d.Rows(i))
        Next
        If t Is Nothing Then Exit Sub
        t.EntireRow.Select '.Delete
    End Sub

（白茶） 2022/06/23(木) 18:00

私も「個数が少ない」というのがよくわかってないですが、Office365ですからMAXIFSをつかって、その行がグループのなかで一番大きいのか判定し、条件を満たす行をすべて取り出せば、それより個数が少ない行を削除したことと同じになりませんか？

（もこな２） 2022/06/23(木) 19:55

白茶様ありがとうございます。お示し頂いたコードで上手く動きました。
私の理解力と提示方法がいけなかったのですが実際のシートの
「列」は下記となっています。

_|____D_____|__　_G___|__　_J____|___M____|______

 1|品名   　　   　|　　　個数    |　　　分類１  |　　　分類２  |        
 2|砂糖      　　　|      　　　 3|　　　調味料  |　　　雑貨    |    
 3|コーヒー  　　　|       　　　4|　　　嗜好    |　　　雑貨    |   
 4|みかん    　　　|       　　　4|　　　フルーツ|　　　柑橘    |       
 5|夏みかん  　　　|       　　　2|　　　フルーツ|　　　柑橘    |       
 6|メロン    　　　|       　　　3|　　　フルーツ|　　　果物    |                    
 7|菜っ葉    　　　|       　　　6|　　　野菜    |　　　葉物    |   
 8|ジャガイモ　　　|       　　　2|　　　野菜    |　　　根菜    |

理解不足でどこをどう直してよいやら解りません。
大変お手数ですが、上記「列」で再度コードをお示し頂くことは可能でしょうか？
何卒よろしくお願いいたします。
（さかえ） 2022/06/24(金) 15:10

トピ主には刺さらなかったようですが、こういうことじゃないんでしょうか？

    Sub テキトー()
        Range("H2:H8").Formula = "=IF(MAXIFS($E$2:$E$8,$F$2:$F$8,F2,$G$2:$G$8,G2)>E2,""←この行削除"","""")"
    End Sub

（もこな２） 2022/06/24(金) 17:47

失礼。列が飛び飛びでした。

    Sub テキトー改()
        Range("N2:N8").Formula = "=IF(MAXIFS($G$2:$G$8,$J$2:$J$8,J2,$M$2:$M$8,M2)>G2,""←この行削除"","""")"
    End Sub

（もこな２） 2022/06/24(金) 17:51

コメント返信：

[ 一覧(最新更新順) ]

[[20220623122541]] 『分類１で重複した行を条件を指定して削除したい』（さかえ） ページの最後に飛ぶ

[[20220623122541]]　『分類１で重複した行を条件を指定して削除したい』（さかえ）　ページの最後に飛ぶ