[[20130521175422]]　『色つきセルを選んで移動するには？』（KAME）　ページの最後に飛ぶ

『色つきセルを選んで移動するには？』（KAME）

お世話になります。

A1:A4の間のセルでセル色が青だけをB1:B4へ上から詰めてコピーさせるには
どのようにすれば良いか？ご教授の程よろしくお願いします。

例）
A1 セル色　赤
A2 セル色　青
A3 セル色　無し
A4 セル色　青

 A  　　　　　B　　　　　　　　　A  　　　 B
1リンゴ　　　　　　　　　　1 リンゴ　　みかん
2みかん　　　　　　　　　　2 みかん　　バナナ
3なし　　　　　　　　→　　3 なし
4バナナ　　　　　　　　　　4 バナナ

WIN2007 EXCEL2010

 1行目をタイトル行にして、オートフィルターを設定。
 色フィルターで青を選んで抽出。青だけになったＡ列を選んで別のシートにコピペ。
 元シートのオートフィルターを解除した上で、別シートからＢ列にコピペ。

 (ぶらっと)

 2010なら。こんな方法も。

 範囲を選択（このばあいA1～A4)
 Ctrl+F　または　ホームタブにある「検索と選択」から「検索」

 出てきた画面でオプションボタンを押す。
 右上の書式ボタンを押す。
 塗りつぶしタブで青を選択。OKして閉じる。
 そのまま（検索する文字列には何もいれずに）「すべて検索」ボタンを押す。
 下に青色のセル名が一覧で並ぶので、Shift押しながら一番上と一番下をクリックして全部を選択。
 そのまま「閉じる」ボタンを押す。

 シートに戻ると青のセルだけ選択状態になっているので、そのままコピー。
 B1を選択してペースト。

 こんなもんで。
 (1111)

ぶらっと様・1111様
ありがとうございます。

言葉足らずで申し訳ありません。
実は質問の動きをVBAでさせたいのです。

どうかアドバイスをよろしくお願い致します。

 こんなのでは？
 Sub sample()  '青色が付いていたら隣の列に値を転記
    Dim iro As Long
    Dim c As Range, r As Range, t As Range

    Set t = Range("B1")    '転記先
    Set r = Range("A1", Range("A" & Rows.Count).End(xlUp))  '転記元
    r.Offset(, 1).ClearContents  '転記元の隣の列をクリア
    For Each c In r
        iro = c.Interior.Color
            If iro = vbBlue Then
                t.Value = c.Value
                Set t = t.Offset(1)
            End If
    Next
 End Sub

 (usamiyu)

 別案で。

 Sub Sample()
    Dim c As Range
    Dim k As Long
    Dim V() As Variant
    Dim myColor As Long

    myColor = vbBlue '指定色

    '念のため空白セルで色塗りセルがＡ列の下にある状況もカバー
    With Intersect(ActiveSheet.UsedRange, Columns("A"))
        ReDim V(1 To .Rows.Count, 1 To 1)
        For Each c In .Cells
            If c.Interior.Color = myColor Then
                k = k + 1
                V(k, 1) = c.Value
            End If
        Next
    End With

    Columns("B").Clear
    With Range("B1").Resize(k)
        .Value = V
        .Interior.Color = myColor
    End With
 End Sub

 (ぶらっと)

 参考出品。上でコメントしたオートフィルター処理。（タイトル行は不要）

 Sub Sample2()
    Columns("B").Clear
    Range("A1").Insert
    Range("A1").Value = "Dummy"
    ActiveSheet.AutoFilterMode = False 'Just in Case
    Range("A1").AutoFilter Field:=1, Criteria1:=vbBlue, Operator:=xlFilterCellColor
    With ActiveSheet.AutoFilter.Range
        If .SpecialCells(xlCellTypeVisible) > 2 Then .Copy Range("B1")
    End With
    ActiveSheet.AutoFilterMode = False
    Rows(1).Delete

 End Sub

 (ぶらっと)

コメント返信：

[ 一覧(最新更新順) ]

[[20130521175422]] 『色つきセルを選んで移動するには？』（KAME） ページの最後に飛ぶ

[[20130521175422]]　『色つきセルを選んで移動するには？』（KAME）　ページの最後に飛ぶ