[[20180310164802]] 『一致するデータを範囲を指定して削除したいです』(佐竹ゆうこ) ページの最後に飛ぶ

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

 

『一致するデータを範囲を指定して削除したいです』(佐竹ゆうこ)

エクセル初心者です。やさしくお願いします。

B10からB29までに、数値(1から999)を入れると、
B36からB300までで一致する数値を探し(B列で検索)、
一致したら、その行のBからМ列までを消して、上につめるマクロをおしえてください。
B36から下は在庫帳簿になっており、
B10からB29が使用したものの帳票です。
使うと、B36から下の一致したデータのB列からМ列までが消える形です。
ほかにも同じシートにいろいろデータが詰まっていて、
該当する範囲のみ削除するのがうまくいきません。
よろしくお願いいたします。

例  Bに45という数値が入ると、B36からМ36のデータが消えて、下のデータが上に上がる。
    なたね油の行が新たにB36列目にくる。

_________ __ __B____C__________D_______E

___10行目__45___酒かす___4種____岩手___農協____1キロ_____200円

___29行目

____________B______C__________D________E___________F_____G_____H____________I_____J________K_____L____M
__36行目__45___酒かす___1キロ___200円___ 農協__4___10月4日_____________________________境山 
__37行目__71___なたね油_10L_____450円___角館___5___10月27日__20_石丸____10%______相沢
__38行目__103__牛糞_____20キロ__820円___埼玉___8___11月12日___________一般_____C_____風見

300まであります。エクセル2010使用です。

< 使用 Excel:Excel2004(Mac)、使用 OS:Windows7 >


B9とB35には何が入力されていますか

(マナ) 2018/03/10(土) 17:11


B9は、数字という文字で、
35も、同じく数字です。
どちらも見出しです。
(佐竹ゆうこ) 2018/03/10(土) 17:17

フィルタオプションという機能があるのをご存知ですか。
これを使って、該当する行のみ抽出し、行削除するとよいです。

まずは、手作業で試してみるとよいです。
使ったことがなければ、ネットで検索してみてください。

(マナ) 2018/03/10(土) 17:23


マクロでお願いします
(佐竹ゆうこ) 2018/03/10(土) 17:37

>マクロでお願いします

はい。承知しています。

>やさしくお願いします。

ということなので、

>まずは、手作業で試してみるとよいです。

(マナ) 2018/03/10(土) 17:43


失礼します。
>該当する範囲のみ削除するのがうまくいきません
ですので、たぶん手作業でも無理だと思います。(EXCEL2016ではやり方が悪いのかもですが、出来ません)

マクロの使い方は出来ますか?

Sub 在庫数字削除()

    Dim i As Long
    Dim cnt As Long
    Dim rrr As Range
    Dim crR As Range
    Dim rlist As Range

    Set crR = Range("B19")
    Set crR = Intersect(crR.CurrentRegion, Range("B19:B29"), Range(crR, crR.End(xlDown)))   '削除対象の途中に空白無いこと
    If crR.Rows.Count = 1 Then
        crR.Offset(1).Select
        MsgBox "削除する数字を入力ください"
        Exit Sub
    End If
    Set rlist = Range("B35")
    Set rlist = Range(rlist, rlist.End(xlDown))
    Set rlist = Intersect(Range("B35:B300"), rlist).Resize(, 12)    '在庫の途中の数字に空白無いこと
    rlist.AdvancedFilter xlFilterInPlace, crR, , False
    Set rrr = Intersect(rlist.Offset(1), rlist.SpecialCells(xlCellTypeVisible))
    crR.Worksheet.ShowAllData
    If rrr Is Nothing Then
        MsgBox "すでに該当数字は全て削除されています"
        Exit Sub
    End If
    For i = rrr.Areas.Count To 1 Step -1
        cnt = cnt + rrr.Areas(i).Rows.Count
        rrr.Areas(i).Delete xlShiftUp                               '該当範囲削除
    Next
    Range("B301").Offset(-cnt).Resize(cnt, 12).Insert xlShiftDown   '削除した分を下に挿入
    crR.Select
    MsgBox cnt & " 件を削除しました"
    Intersect(crR, crR.Offset(1)).ClearContents
End Sub

(kazuo) 2018/03/10(土) 20:21


回答ではなく確認です。

検索するのはB列として
>一致したら、その行のBからМ列までを消して、上につめるマクロをおしえてください。
とのことですが、A列やM列以降が削除されるとまずいんでしょうか?

>エクセル初心者です。やさしくお願いします。
>マクロをおしえてください。
VBAについて基本的なことはわかってるとの理解でよいですか?
また、ある程度作ったものがあってどこかで詰まってるいるということでしょうか?
まったくの0から作ってくれとの仕事の丸投げであれば、私は対応する気がないので撤退します。
(もこな2) 2018/03/10(土) 22:48


 こんばんはI 
方法は色々あると思いますし、エラーも出ると思いますが、
後は、お勉強して頂くとして
トピ主さんの
 >B10からB29までに、数値(1から999)を入れると、 
 >B36からB300までで一致する数値を探し(B列で検索)、 
 > 一致したら、その行のBからМ列までを消して、上につめるマクロをおしえてください。 
 の部分をコードにしてみました。
あっ、消すと検証するのが面倒だったので色を付けておきました。
まぁそこから改造して下さい。
私は一週間に一問程度しか回答出来ませんので、何かの参考になれば幸いです。
では、では、

 Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range
Dim v As Range
Dim rr As Range
Dim rrr As Range
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Intersect(Target, Range("B10:B29")) Is Nothing Then Exit Sub
Application.EnableEvents = False
    For Each r In Range("B10:B29")
        If IsNumeric(r.Value) Then
            If Int(r.Value) = r.Value Then
                If (r.Value >= 1) * (r.Value <= 999) Then
                    For Each v In Range("B36:B300")
                        If v.Value = r.Value Then
                            Set rr = v.Resize(, 12)
                            If rrr Is Nothing Then
                                Set rrr = rr
                            Else
                                Set rrr = Union(rr, rrr)
                            End If
                        End If
                    Next
                End If
            End If
        End If
    Next
    Range("B36:M300").Interior.Color = xlNone
    If Not rrr Is Nothing Then
        rrr.Interior.Color = 65535
'        rrr.Delete
    End If
Application.EnableEvents = True
End Sub
v(=∩_∩=)v
(SoulMan) 2018/03/11(日) 00:06

 こんにちは ^^
もこな2さん
マナさん
がアドバイスを
kazuoさん
SoulManさん
が既にご呈示ですが、作ってみましたので何かの参考まで(ならないかもです^^;)
同じくあとは、お勉強して頂くとして。。。
Excel2004(MAc)無いので確認は出来ていません。?

 Option Explicit
'**********************************************************
Sub main()
    Dim sh As Worksheet, sh01 As Worksheet
    Dim i As Long, j As Long, cnt As Long
    Dim r As Range, rr As Range, rrr As Range
    Set sh = ThisWorkbook.Worksheets("Sheet1")
    sh.Copy
    ActiveSheet.Name = Format(Now, "yyyymmdd-hhmmss")
    Set sh01 = Worksheets(ActiveWorkbook.Sheets(1).Name)
    Set r = sh01.Range("B10:B29")
    Set rr = sh01.Range("B36:M300")
    For i = 1 To rr.Rows.Count
        For j = 1 To r.Rows.Count
            If rr(i, 1) = r(j, 1) Then
                cnt = cnt + 1
                If cnt = 1 Then
                    Set rrr = sh01.Range(rr(i, 1), rr(i, 12))
                Else
                    Set rrr = Union(rrr, sh01.Range(rr(i, 1), rr(i, 12)))
                End If
            End If
        Next
    Next
    If Not rrr Is Nothing Then
        'rrr.Delete shift:=xlShiftUp
        rrr.Select
    End If
    Set r = Nothing
    Set rr = Nothing
    Set rrr = Nothing
    Set sh01 = Nothing
    Set sh = Nothing
End Sub
(隠居じーさん) 2018/03/11(日) 07:48

>ほかにも同じシートにいろいろデータが詰まっていて、
>該当する範囲のみ削除するのがうまくいきません。

並び替えは可能でしょうか?
並び替えてよければ、
不要なデータはクリアをして並び替えることで、
空白は下に追いやられるので、
対象範囲以外のセルに影響は出ないと思います。
(まっつわん) 2018/03/11(日) 10:28


もこな2さま
A列やM列以降が削除されるとまずいんでしょうか?

わたしが前任から3月に引き継いだ表で、
A列やМ列に以降には、データや説明文などがはいっており、
勝手に削除できません。
マクロについては、少しかじった程度ですが、
最終行の取得法や、オフセットの使い方など、コードはある程度読み書きできます。
で、やってみたところ、Vlookupをワークシート関数として使用したり、find関数なども試したのですが、うまくいかず、質問したしだいです。

すいませんです。

マナさん、kazuoさん、もこな2さん、SoulManさん、隠居じーさんさん、まっつわんさん、
いろいろなアドバイスありがとうございます。
明日から会社で、別シートに書き出して、いろいろ実験してみます。
また、お聞きするかもしれません。
そのときはよろしくお願いいたします。
(佐竹ゆうこ) 2018/03/11(日) 12:49


まずは手作業だと思いますが
 Option Explicit

 Sub test()
    Dim r As Range
    Dim c As Range
    Dim t As Range

    Set r = Range("B35:M300")
    Set c = Range("ZZ1:ZZ2")
    c(2).Formula = "=countif($B$10:$B$29,B36)=0"
    Set t = c(1).Offset(, 1)

    r.AdvancedFilter xlFilterCopy, c, t
    r.Value = t.Resize(r.Rows.Count, r.Columns.Count).Value
    c.CurrentRegion.ClearContents

 End Sub

(マナ) 2018/03/11(日) 13:48


Match関数使ってみました。
動作は未確認です。
したいことはこんな流れですよね?

Option Explicit

Sub test()

    Dim rng使用 As Range
    Dim rng在庫 As Range
    Dim c As Range

    With ActiveSheet
        Set rng使用 = .Range("B10:M29")
        Set rng在庫 = .Range("B36:M300")
    End With

    For Each c In rng使用.Columns(1).Cells
        Getデータ c
    Next
    With rng在庫
        .Sort key1:=rngList(1), order1:=xlAscending, header:=xlNo
    End With
End Sub

Private Function Getデータ(ByVal rngKey As Range, ByVal rngList As Range)

    Dim ixRow As Long

    On Error GoTo Wayout
    ixRow = WorksheetFunction.Match(rngKey, rngList, 0)
    On Error GoTo 0

    With rngList.Rows(ix)
        .Copy rngKey
        .ClearContents
    End With

Wayout:
End Function

(まっつわん) 2018/03/11(日) 16:43


マナさんへ
済みませんでした。ちょっと手間がかかりますが、確かに手作業で出来ますね。
数式の使い方理解していませんでした。

佐竹ゆうこさんへ
私のは B9 をB19 と書いたり他にも無駄がありますので無視してください。

(kazuo) 2018/03/11(日) 19:49


必ずしも手作業でよいと思っているのではなく、
いきなり完成形のマクロを提示しても理解出来ないであろうから

特に、フィルター関連のマクロでは
「まずは」手作業で試してとお願いしています。

で、その次の段階は、「マクロの記録」です。

なかなか、そういう展開にはなりませんが。

(マナ) 2018/03/11(日) 20:12


たぶん、流れとしては
1.B10〜B29セルのどこかに数字の入力があったら感知する
2.36行目から300行目までの、B列をみて、1で入力された数値に該当する行を抽出する
3.抽出した行のB列〜M列を削除して上にシフトする
ということになるとおもいます。

おそらく、マナさんは、2〜3の手動操作をマクロの記録を使ってどのような記述をすればよいのか調べてみては?ということを仰りたいのだとおもいますし、私も同じように思います。
それを踏まえて、以下蛇足です。

1のように、〇〇されたときに××するというのは、「イベント」というものがあります。
今回のケースで言えば、セルに入力された(=セルの内容が変更された)ことを条件にマクロを動かせばよいということになるので、Changeイベントが使えると思います。
たとえば、こんな感じ↓(シートモジュールに記述してください)

Private Sub Worksheet_Change(ByVal Target As Range)

    '「Target」がB10〜B29の範囲でなければ終了
    If Intersect(Target, Range("B10:B29")) Is Nothing Then Exit Sub

    '「Target」が単一セルでなければ終了
    If Target.Count > 1 Then Exit Sub

    '「Target」の値がブランクなら終了
    If Target.Value = "" Then Exit Sub

    '「Target」の値が1〜999でなければ終了
    Select Case Target.Value
        Case 1 To 999
            MsgBox "B列が" & Target.Value & "になってる行を探して" & vbCrLf & _
                        "B〜M列を削除して、上方向にシフトしよう"
        Case Else
            '予定されている検索値でないので無視(=終了)
            Exit Sub
    End Select
End Sub

2の作業は、Excel君が元々持っているフィルター機能をつかってあげたほうが高速動作するとおもいますが、あえて学習のため別方法を取るというのであれば、B36〜B300のセルを一つずつ条件に一致するのか見て、条件に一致した場合は、削除予定範囲に追加してやるというアプローチもあるとおもいます。
↓たとえば、こんな感じ
Sub Sample()
'==変数の宣言とか

    Const 検索値 As Long = 123 '←テスト用
    Dim i As Long
    Dim 最終行 As Long
    Dim MyRng As Range

'==処理

    With ActiveSheet
        '最終行が36行未満であれば、データが無いと言うことだから終了
        最終行 = .Cells(.Rows.Count, "B").End(xlUp).Row
        If 最終行 < 36 Then Exit Sub

        'ループ処理で検索値に合致する行を取得する
        For i = 36 To 最終行
            If .Cells(i, "B").Value = 検索値 Then
                If MyRng Is Nothing Then
                    Set MyRng = .Rows(i)
                Else
                    Set MyRng = Union(MyRng, .Rows(i))
                End If
            End If
        Next i

        If MyRng Is Nothing Then
            'MyRngに何もセットされていないということは、合致する行が無かったのだから終了
            Exit Sub
        Else
            Intersect(MyRng, .Columns("B:M")).Select'テスト用
            'Intersect(MyRng, .Columns("B:M")).Delete (xlShiftUp)'コメントアウトを解除すれば問答無用で削除が発動します
        End If
    End With
End Sub

↑コード中にもコメントつけてありますが、3は提示の条件だけであればそのまま削除すれば良いということになりますけど、運用面を考えた場合、数字を入力したら問答無用で削除するので、うっかり削除されたくない数字入力しちゃったらどうするのかちょっと心配になります。(マクロで実行したことは、「元に戻す」が使えません。)

以上、蛇足でした。
興味があったら研究材料にでもしてください。

(もこな2) 2018/03/12(月) 11:43


コメント返信:

[ 一覧(最新更新順) ]


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