[[20160921130036]] 『重複している中で条件抽出』(よーこー) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『重複している中で条件抽出』(よーこー)

はじめまして。Excelのマクロについて質問です。
下記のようになっている時に、商品が重複していて、かつ、取引区分が売買両方ある行を削除したいのですがどのように記述したらいいのかわかりません。

ご教授よろしくおねがいします。

商品 取引区分
123 買
987 売
654 買
456 買
123 売
987 売
123 売
456 買

< 使用 Excel:Excel2010、使用 OS:WindowsXP >


 Sub test()
    Dim i As Long
    Dim j As Long

    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        For j = i + 1 To Cells(Rows.Count, "A").End(xlUp).Row
            If Cells(i, "C").Value = "" Then
                If Cells(i, "A").Value = Cells(j, "A").Value And _
                   Cells(i, "B").Value <> Cells(j, "B").Value And _
                   Cells(j, "C").Value = "" Then
                   Cells(i, "C").Value = 1
                   Cells(j, "C").Value = 1
                   Exit For
                End If
            End If
        Next j
    Next i
    For i = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        If Cells(i, "C").Value = 1 Then
            Rows(i).Delete
        End If
    Next i
 End Sub
(13:27 修正)
(???) 2016/09/21(水) 13:21

質問のデータの場合、以下のような処理になるのですか?

商品123の行をすべて削除(計3行)
他の行は削除しない

そんな場合の一例です。

 Sub マクロ()
    Dim k, LR
    Dim myR1, myR2, myR3

    LR = Cells(Rows.Count, 1).End(xlUp).Row
    Set myR1 = Cells(2, 1).Resize(LR - 1)
    Set myR2 = myR1.Offset(, 1)
    Set myR3 = Cells(1)

    For k = 2 To LR
        If WorksheetFunction.CountIfs(myR1, Cells(k, 1), myR2, "売") Then
        If WorksheetFunction.CountIfs(myR1, Cells(k, 1), myR2, "買") Then
        Set myR3 = Union(myR3, Rows(k))
        End If
        End If
    Next

    Set myR3 = Intersect(myR3, Rows(2).Resize(Rows.Count - 1))
        If Not myR3 Is Nothing Then
            myR3.Delete shift:=xlUp
        End If
 End Sub

(x-ab) 2016/09/21(水) 14:06


 アップされた例の場合 123 は削除になりますか? それとも、売買のペアで削除?(123 の売が1行残る?)

 もし、123 すべてが削除ということでいいなら、

 C1 : =IF((COUNTIFS(A:A,A1,B:B,IF(B1="買","売","買")))>0,TRUE,"")

 これを 下にフィルコピーしておいて、C列を選択して、検索と選択 -> 条件を選択してジャンプ(S)
 数式(F)を選び、チェックボックスを 理論値(G)のチェックだけを残し、あとはチェックを外してOK.

 この状態で削除 -> シートの行を削除(R)

 これでできますし、必要なら、この一連の操作をマクロ記録すればコードが生成されますね。

(β) 2016/09/21(水) 14:06


 もし、上記でいいなら、マクロ記録したものを少しブラッシュアップしたものが以下です。

 Sub Sample()
    With Range("A1").CurrentRegion
        .Columns("C").Formula = "=IF((COUNTIFS(A:A,A1,B:B,IF(B1=""買"",""売"",""買"")))>0,TRUE,"""")"
        On Error Resume Next
        Columns("C").SpecialCells(xlCellTypeFormulas, xlLogical).EntireRow.Delete
        On Error GoTo 0
        .Columns("C").ClearContents
    End With
 End Sub

(β) 2016/09/21(水) 14:15


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.