EXCEL VBA　条件に合致しない行を削除したい

Question

超初心者です。どうか教えてください・・・m(_ _)m

Ａ列　　　Ｂ列　　　・・・・・
1234567　 2345678
9876543　 8765432
　・　　　　・
　・　　　　・

といった、表（数千行規模）があります。
Ａ列とＢ列には７桁の数字があります。
Ａ列とＢ列には途中ブランクのセルもあります。

Ａ列またはＢ列のどちらかにも、
複数の範囲条件（数字）に合致しない行を削除したいです。
Ａ列またはＢ列のどちらかに合致すればその行を残します。

複数の範囲条件（数字）
（例）
　1000000～1000009
　2000100～2000199
　　　　・
　　　　・
　　十数個あります。

何卒、宜しくお願い致します。・・・m(_ _)m

mitarashi · Accepted Answer

#2です。
条件の後出しをしないで、ご自分でアレンジする才覚を持っていただかないと、後々メンテナンス出来ないで困りますよ。
コード中のコメントを読んでから、バックアップを取った上で実行して下さい。
Sub test()
  Dim ref(9999999) As Boolean
  Dim criteriaRange As Range
  Dim targetRange As Range
  Dim myRow As Range
  Dim buf As Variant
  Dim i As Long
  
  With Sheets(1)
    '最初のシートのA3からの処理に変更
    Set targetRange = Range(.Range("A3"), .Range("B" & .Rows.Count).End(xlUp))
  End With
  buf = targetRange
  With Sheets(2)
    Set criteriaRange = Range(.Range("A1"), .Range("B" & .Rows.Count).End(xlUp))
  End With
  For Each myRow In criteriaRange.Rows
    For i = myRow.Cells(1) To myRow.Cells(2)
      ref(i) = True
    Next i
  Next myRow
  For i = 1 To UBound(buf, 1)
    If ref(CLng(buf(i, 1))) Or ref(CLng(buf(i, 2))) Then
    Else
      buf(i, 1) = Empty
      buf(i, 2) = Empty
    End If
  Next i
  '最初のシートの行削除に変更（必ずバックアップを取ってから試行の事）
  targetRange = buf
  targetRange.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

mitarashi · Answer

#2です。
A,B列に入っている「数字」のデータ型の問題でしょうか、
If ref(buf(i, 1)) Or ref(buf(i, 2)) Then
のところを
    If ref(CLng(buf(i, 1))) Or ref(CLng(buf(i, 2))) Then
にしてみて下さい。
それでもダメなら、コードが中断したところで、buf(i,1)の値がマウスポインタを持って行くと表示されると思いますので、どんな値が入っているかお知らせ下さい。

mitarashi · Answer

興味本位でやってみましたので、自称超初心者さん向けではないと思います。メモリー大盤振る舞いの案です。スピード命のつもりですので、親切な方から分かり易い回答があったら、処理速度を比べてみて下さい。
'Sheets(1)にチェック対象のデータがある
'Sheets(2)のA列に範囲の最初、B列に範囲の最後の値が入っている
'A1が1000000、B1が1000009という様に。以下下方に続く
'Sheets(3)に削除されなかったデータを貼り付ける（Sheets(1)はいじりません）
'Sheets(1)のブランクの行も削除対象になります。

配列ref()のref(1000000),ref(1000001),...ref(100009)をtrueにしておき、
1234567がこの範囲に含まれるかどうかチェックするには、ref(1234567)がtrueかどうかを見ればよいという案です。
Sub test()
  Dim ref(9999999) As Boolean
  Dim criteriaRange As Range
  Dim targetRange As Range
  Dim myRow As Range
  Dim buf As Variant
  Dim i As Long
  
  With Sheets(1)
    Set targetRange = Range(.Range("A1"), .Range("B" & .Rows.Count).End(xlUp))
  End With
  buf = targetRange
  With Sheets(2)
    Set criteriaRange = Range(.Range("A1"), .Range("B" & .Rows.Count).End(xlUp))
  End With
  For Each myRow In criteriaRange.Rows
    For i = myRow.Cells(1) To myRow.Cells(2)
      ref(i) = True
    Next i
  Next myRow
  For i = 1 To UBound(buf, 1)
    If ref(buf(i, 1)) Or ref(buf(i, 2)) Then
    Else
      buf(i, 1) = Empty
      buf(i, 2) = Empty
    End If
  Next i
  Sheets(3).Range(targetRange.Address) = buf
  Sheets(3).Range(targetRange.Address).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

mt2008 · Answer

「教えてください」と、言われても何が判らないのかが書いて無いと答えようが無いです。
とりあえず、やり方が判らないのだと判断してアドバイス。
表を一行づつ見て行って、A列の値、B列の値がどちらも複数の範囲行件に合致しない場合はその行を削除する……と、言う事を地道に繰り返すのが一番簡単。

・「複数の範囲条件」をどこか別のシートに持つ事をお勧めします。
　例えば、Sheet2のA1に1000000、B1に1000009、A2に2000100、B2に2000199、……。

・表を見て行く時は下から上に。上から下に見て行くと、行を削除した時アクティブな行がどこかが判りにくい。

・何千行もあると、画面更新するだけで時間が掛かるので、Application.ScreenUpdating = Falseで画面の更新を止め、最後にApplication.ScreenUpdating = Trueとして戻すと早い。

・複数の範囲条件に合致するか否かは、functionで作ってサブルーチン化した方が判りやすい。
　＃例：引数で数値を渡すと範囲条件のどれかに合致するならTrueを返す

EXCEL VBA 条件に合致しない行を削除したい

#2です。

#2です。

興味本位でやってみましたので、自称超初心者さん向けではないと思います。

この回答への補足

「教えてください」と、言われても何が判らないのかが書いて無いと答えようが無いです。

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

このQ&Aを見た人はこんなQ&Aも見ています

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

このQ&Aを見た人がよく見るQ&A

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

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

EXCEL VBA　条件に合致しない行を削除したい