Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2016)
事象が起こった行の削除
投稿日時: 20/04/08 15:04:42
投稿者: Manabukunn

この度はお世話になります。
 
エクセルのシートに次のようなデータがはいっているとします
 
  A列 B列  C列
  ID 年度 事象  ※事象:1=事象あり
  1 2014 1
  1 2015  
  1 2016
  2 2013 
  2 2014
  2 2015
    3 2014 1
    3 2013
    3 2015
    3 2016
 
すなわちID順で並んであるのですが事象が起きた年度がそのIDの中で
最初の行になって先頭行以外は事象にデータが入っていない状態です。
 
これらの並びにおいて事象が起こったIDにおいてはその他の年度の
行も削除するという操作をVBAで行いたいと考えております。
すなわちID =1の2014年を含めてすべて、ID=3の2014年を含めてすべて
 
10万行程度あるのでとても手作業では無理なので
何とかしたいと思っております。
お知恵をお願いいたします。
 
 
 

回答
投稿日時: 20/04/08 15:49:16
投稿者: WinArrow
投稿者のウェブサイトに移動

何とかしたい
 
という言葉だけ理解しました。
 
このままだと丸投げ状態ではあるが、
 
説明がいまいち理解できない。
>ID =1の2014年を含めてすべて
 
例示の表には、「ID=1 & 2014」 は、1件しかないが、
複数件あるということなの?
 
 
 

回答
投稿日時: 20/04/08 16:09:25
投稿者: mattuwan44

1)フィルターオプションで事象の列に1が入っている年度を重複を取り除いて別のシートに抽出
2)抽出された年度をそれ以外のOr条件の表を作る
3)2で作った条件でさらに別のシートにID、年度、を抽出
 
で、出来ると思いますが、マクロまで必要でしょうか?
必要なら、それを自動化してはいかがでしょう?
 
あるいは、事象の列は空白か1が入力かどちらかなら、
Ctrlキー+↓キーで次を探して、
そのB列の値を置換機能で順次クリアし、
その後、B列をキーで並び替え、
一番下のデータをCtrlキー+↓キーで探して、
その下の行を選択し
Ctrlキー+Shiftキー+↓キーで選択しクリア
その後IDで並べなおす
 
などでも出来そうかな?
どちらも手順は複雑ですが、
いまからマクロを覚えるよりは結果は早く出ると思います。

投稿日時: 20/04/08 16:23:04
投稿者: Manabukunn

コメントありがとうございます。
 
WinArrowのご質問に関してですが
ID=1の方は2014年に事象が起きているのでこの行を削除
合わせてID=1の方の2015、2016の行も削除したいということです。
 
同じようにID=3の方は2014年に事象が起きているのでこの行を削除
合わせて2013、2015、2016も削除したいということです。
 
自分では
 
Sub delete_malig()
 
Dim i As Long
 
Dim x As Long
 
Dim ID As Variant
 
 
    For i = 2 To 101572
 
        If Cells(i, 3).Value = 1 Then
 
            ID = Cells(i, 2).Value
             
            Rows(i).Delete
     
                For x = i + 1 To 101572
     
                    If Cells(x, 2).Value = ID Then
      
                        Rows(x).Delete
      
                    Else
                     
                        i = x
                         
                        Exit For
                     
                    End If
                     
                Next
                 
        End If
                 
    Next
 
End Sub
 
なものを作成しましたが、これだと例えばID=1の2014年、ID=3の2014年の行は
削除されますがその他ID=1、ID=3の行は削除されませんでした。
 
このマクロの
 
i = x にして  For x = i + 1 To 101572のループを抜け出して
 
For i = 2 To 101572 の i にこの x を引き継ぎたい感じで作成したのですが
 
うまく行っていないと思われます。
 
お忙しいところ申し訳ありませんが
 
ご指導お願いいたします。
 

投稿日時: 20/04/08 16:39:34
投稿者: Manabukunn

追記ですが
 
最終的に
 
  A列 B列  C列
  ID 年度 事象  
  2 2013 
  2 2014
  2 2015
 
事象がないID=2のデータだけ残したいということです。
 
ご指導お願いいたします。

回答
投稿日時: 20/04/08 17:29:37
投稿者: WinArrow
投稿者のウェブサイトに移動

Manabukunn さん
 
回答ありがとうございました。
自分がわかっていることを他人にキチンと伝えるって難しいよね?
 
 
複数の行をループを使って削除する場合は、
下の行から削除するのが常套手段です。
 
ですが、その前に事象=1のIDを検出する必要があります。
事象=1を検出するには、オートフィルタを使います。
その時のIDを変数(配列)に格納してから
変数ではなく、別シートに抽出でもよいでしょう。
 
次は、変数のIDで、オートフィルタで抽出して、一挙に削除します。
 
ループを使わずに処理できます、
 
第1段階のオートフィルタも第2段階のオートフィルタも、マクロの記録でコードが作成できるので、
挑戦してみてください。
各々が完成したら、マクロを一緒にすれば出来上がりです。

回答
投稿日時: 20/04/08 17:31:07
投稿者: WinArrow
投稿者のウェブサイトに移動

追加コメント
 
ループ処理より、オートフィルタを使った方が断然早い

投稿日時: 20/04/08 17:53:46
投稿者: Manabukunn

WinArrowさんコメント有難うございます。
 
 
 
次は、変数のIDで、オートフィルタで抽出して、一挙に削除します。
 
 
にかんしてですが別のシートにコピペしたとして標準機能で
できるのでしょうか。
この点に関して申し訳ありませんがご教授お願いいたします。[/quote]

回答
投稿日時: 20/04/08 20:05:55
投稿者: mattuwan44

Sub test()
    Dim i As Long
    Dim flg As Boolean
 
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(i, 1).Value <> Cells(i - 1, 1).Value Then
            If Cells(i, 3).Value > 0 Then
                flg = True
            Else
                flg = False
            End If
        End If
        If flg = True Then Cells(i, 2).ClearContents
    Next
     
    With ActiveSheet.UsedRange
        .Columns("B").SpecialCells(xlCellTypeBlanks).EntireRow.ClearContents
        .Sort key1:=Range("A1"), Header:=xlYes
    End With
End Sub
 
ループなら例えば、こんな感じですかね。
セルの読み書きは時間が掛かるので無駄な無関係のセルは見ないようにしましょう。
行の削除なら下からだけど、フラグが上に立ってるので、
上から一回目印になるセルをクリアしておいてから、
ジャンプ機能で空白を検索し、クリア
その後、並び替えで空白行を詰めてみました。
行削除するよりクリアして並び替えた方が速かった気がします。
配列変数を使ったり、
VBAでループを書かなくすると速くなると思います。

回答
投稿日時: 20/04/08 22:54:39
投稿者: WinArrow
投稿者のウェブサイトに移動

オートフィルタを使った
サンプルです。
 
Sub Sample()
 
Dim RA As Range, RB As Range, CKEY, i As Long
 
    With Sheets("Sheet1")
        With .UsedRange
        '事象でオートフィルタ(1回目)
            .AutoFilter Field:=3, Criteria1:="<>"
            Set RA = .Columns("A").SpecialCells(xlCellTypeVisible)
        'IDを配列変数に格納
            i = 0: ReDim CKEY(i)
            For Each RB In RA
                If RB.Row > 1 Then
                    ReDim Preserve CKEY(0 To i)
                    CKEY(i) = CStr(RB.Value)
                    i = i + 1
                End If
            Next
            .AutoFilter
        'IDでオートフィルタ(2回目)
            .AutoFilter Field:=1, Criteria1:=CKEY, Operator:=xlFilterValues
        'IDで抽出した行を削除
            .Offset(1).EntireRow.Delete Shift:=xlUp
            .AutoFilter
        End With
    End With
End Sub

回答
投稿日時: 20/04/09 10:09:26
投稿者: simple

・削除するのはリスクが高いと思うので、該当データのみ、別のところにコピーする方法です。
(バックアップは別に持っているから削除しても大丈夫なんだろう。
  該当データのみコピーするのと、バックアップ保持とは実質的に同じ意味です。
  いや削除したいんです、と言わないようにしてください。)
・フィルタオプション(フィルタ - 詳細設定)を使用しています。
・見出し設定などもコード内でやっていますから、下記シートのレイアウトを前提として、
 コードを実行してください。J:L列に結果を書き出します。
 
<<シートのレイアウト>>

    A列  B列      C列
 1  ID   年度     事象  
 2  1    2014       1
 3  1    2015        
 4  1    2016      
 5  2    2013      
 6  2    2014    
 7  2    2015     
 8  3    2014       1
 9  3    2013    
10  3    2015    
11  3    2016    

 
<<参考コード>>
Sub test()
    Dim lastRow As Long
    Dim rng     As Range
    
    lastRow = Cells(Rows.count, "A").End(xlUp).Row
    Set rng = Range("A1", Cells(lastRow, 3))
    
    '事象が1となっているIDを重複を排してF列に抽出
    [E1].Value = "事象": [E2].Value = 1
    [f1].Value = "ID"
    rng.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("E1:E2"), _
        CopyToRange:=Range("F1"), _
        Unique:=True
    
    '事象が1ではないデータだけを,J:L列に抽出
    [H1].Value = ""
    [H2].Formula = "=COUNTIF(F:F,A2)=0"
    Range("J1:L1").Value = Array("ID", "年度", "事象")
    rng.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("H1:H2"), _
        CopyToRange:=Range("J1:L1"), Unique:=False
End Sub

必要な修正があれば、そちらでお願いします。

投稿日時: 20/04/10 16:24:18
投稿者: Manabukunn

WinArrowさん、mattuwan44さん、simpleさんありががとうございました。
翻訳に時間がかかりお返事がおくれました^^;
(コロンってなんだ・・・から勉強でした^^;)
 
WinArrowさん
配列の使い方、
.AutoFilter Field:=1, Criteria1:=CKEY
で配列が検索に利用できることを学べ非常に為になりました。
 
また、mattuwan44さんからはループの仕方
simpleさんからはコピーするなど
それぞれ教えていただき感謝しております。
 
今後ともよろしくお願いいたします。