[[20091117104756]] 『色がついた行の削除』(川島) ページの最後に飛ぶ

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

 

『色がついた行の削除』(川島)

はじめまして、いつも参考にさせていただいてます。
マクロ、VBAともに初心者なのですが色々と勉強中です。

住所録のデータ管理をしています。

200件程あるのですが、削除した行に色をつけています。

色がついた行を一括で削除するマクロかVBAはありますか?

検索をしたのですが、いまいちわからなかったので再度質問させて頂きました。

もう1点ですが、そのまま削除してもいいのですが別シートに移動させる事は可能でしょうか?

お忙しいとは思いますが、ご指導宜しくお願い致します。


 VBAをご希望のようですので(マクロも同意として)
 コードを書くにはリストの範囲やシート名(削除シート、データ移動シート)など
 色々必要になります。

 まずは、リストがどのようになっているか
 シートの構成は?
 色は何色でも削除するのか、特定の色だけなのか
 色付けは行全体か、リスト内の特定列だけなのか

 など、明記してみてください。
 (momo)

 酷似なスレ (mitsu)
[[20091111154351]]『文字を表示させない方法』(みかん)
[[20091112112240]]『VBAの機能追加について』(「ニックネームをお忘れなく」と表示されてもつける気のない人)

 データを検索する(または抽出する)という作業をより単純に行おうとするならば、
一般操作でもVBAでも、セル背景色やフォント色を基準にするよりも、
データを基準にすることをお勧めします。
Excel2003以前のバージョンの場合、セルの色は関数、
データメニューで全く役に立ちません。
(みやほりん)(-_∂)b

momoさん、コメントありがとうございます。

シート構成は以下の様になります。

sheet1に住所録が200件程度あります、

A列に番号B3〜X150を対象範囲とし色がついた行を削除したいです。

削除移動をするシートは「削除済シート」です。

色は黄色、色付けは行全体です。

宜しくお願い致します。


 色々な方法がありますが・・・ほんの一例です。

  Sub test()
  Dim r As Range
  Application.FindFormat.Interior.ColorIndex = 6
  With ActiveSheet.Range("B3:X150")
    Set r = .Find(What:="", After:=.Cells(1), LookIn:=xlFormulas, LookAt:=xlPart, _
                  SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
                  MatchByte:=False, SearchFormat:=True)
                  r.Select
    While Not r Is Nothing
      r.EntireRow.Delete
      Set r = .Find(What:="", After:=.Cells(1), LookIn:=xlFormulas, LookAt:=xlPart, _
                    SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
                    MatchByte:=False, SearchFormat:=True)
    Wend
  End With
  End Sub

 (momo)

momoさんありがとうございます!

削除できました!!本当にありがとうございます。

削除済シートに移行するには、どうしたらよいでしょうか?

宜しくお願い致します。


 こんな感じでどうでしょう?

  Sub test()
  Dim r As Range, LastRow As Long
  Application.FindFormat.Interior.ColorIndex = 6
  With ActiveSheet.Range("B3:X150")
    Set r = .Find(What:="", After:=.Cells(1), LookIn:=xlFormulas, LookAt:=xlPart, _
                  SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
                  MatchByte:=False, SearchFormat:=True)
    While Not r Is Nothing
      With Worksheets("削除済シート")
        LastRow = .Range("B" & .Rows.Count).End(xlUp).Offset(1).Row
        r.EntireRow.Copy .Rows(LastRow)
      End With
      r.EntireRow.Delete
      Set r = .Find(What:="", After:=.Cells(1), LookIn:=xlFormulas, LookAt:=xlPart, _
                    SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
                    MatchByte:=False, SearchFormat:=True)
    Wend
  End With
  End Sub

 (momo)

momoさん、ご回答ありがとうございました。

希望通りに出来ました!!!!

本当に助かりました!

ありがとうございました。


コメント返信:

[ 一覧(最新更新順) ]


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