[[20160623103646]] 『フィルター結果を1行毎に貼り付けについて』(かな) ページの最後に飛ぶ

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

 

『フィルター結果を1行毎に貼り付けについて』(かな)

いつもお世話になってます。

別シートのフィルター結果を2行おきに
値のみ貼り付けたいのですが、
1行おきに値のみ貼り付けの方法が分かりません!

どうかお力を貸して下さい。

別シートのフィルター結果を貼り付けまでは
できたのですが、、、

Sub 一覧作成()

Dim k As Long

Dim wk1 As Worksheet
Dim wk2 As Worksheet

Set wk1 = Sheets("フィルター用")
Set wk2 = Sheets("一覧")

  With wk1.Range("I2:I2000")
   wk1.Range("I1").AutoFilter Field:=9, _
                          Criteria1:=65535, _
                          Operator:=xlFilterCellColor

   wk1.Range("I2:I2000").SpecialCells(xlCellTypeVisible).Copy _
     Destination:=wk2.Cells(403, 5)
                           End With

End Sub

< 使用 Excel:Excel2013、使用 OS:Windows7 >


こんにちは

フィルター結果を値で貼り付けてから、不要な行にフラグを立てて

フィルターでそのフラグを立てた行を絞り込んで行削除してはどうですか?
(ウッシ) 2016/06/23(木) 11:37


 回答の前に、以下を明確にしてください。

 1.元シート(フィルター用)のリスト領域は 1行目にタイトル行、列は A列から始まっているんですね?
 2.そのリストに対して I列の値で絞り込み、その結果を 一覧シートに2行おき(1行おき?)に貼り付けるわけですけど
  コードでは 一覧シートの I403 を起点にして、抽出されているリストの I列のみを貼り付けていますね。
  1)この 403行目って、どういう意味ですか?
  2)また、貼り付けるデータは I列のデータだけでいいのですか?それとも、A列からリストのすべての列を貼り付けるのですか?
  3)貼り付けは、常に置換ですか? それとも、すでに一覧にあるデータの末尾に追加ですか?

(β) 2016/06/23(木) 11:45


 追加で教えて下さい。

 抽出条件を 65535 にしてますね。 つまり、I列に 65535 という数字があれば、それを抽出してますけど
 この 65535 には 意味があるんでしょうね? 何の値なんでしょうか?
 (なんとなく xl2003までのエクセル行数である 65536 と似た数字なので気になりまして)

(β) 2016/06/23(木) 11:50


β様

1 1行目にタイトル行、a列から始まってます。

2-1) 403行目から貼り付けたいとおもってます。
それ以前の行には別のデータがあります。

2-2)貼り付けるデータはフィルター結果後のI列だけで大丈夫です。

2-3)403行目を起点に貼り付けたいので、置換だと思います

65535についてですが、
実は色フィルター(条件付書式で色付けた結果)を抽出してるのですが、
その部分のコードの書き方が分からなかったので、
マクロの記録で出たコードを使ってます。
なので、ごめんなさい、私にも数字の意味が分からないです。

まだ勉強中のため、よく分からないコードを提示しちゃって
ごめんなさい!
(かな) 2016/06/23(木) 12:22


ごめんなさい、今大事な事に気付きました!!
2行おきではなく、
1行おきの間違いでした!!
すみません、訂正します、ごめんなさい!
(かな) 2016/06/23(木) 12:35

ちょっと分かりにくいかと思いますが、
フィルター結果の1つ目を403行目に、
フィルター結果の2つ目は405行目に、、、という事にです。

何度もすみません!
(かな) 2016/06/23(木) 12:37


 xlFilterCellColor を見てませんでした。色フィルターだったんですね。

 こんなことですか。

 コピー先でも条件付きが、そのままコピーされていますので、それが不都合なら、その領域の条件付書式を削除してください。
 (マクロの中でもできますが)

 Sub Sample()
    Dim shT As Worksheet
    Dim r As Range
    Dim i As Long

    Set shT = Sheets("一覧")
    shT.Range("I403:I" & Rows.Count).ClearContents
    With Sheets("フィルター用")

        .AutoFilterMode = False
        .Range("A1").AutoFilter Field:=9, Criteria1:=vbYellow, Operator:=xlFilterCellColor

        If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
            Intersect(.Range("A1").CurrentRegion, .Range("A1").CurrentRegion.Offset(1)).Columns("I").Copy shT.Range("I403")

            For i = 404 To shT.Range("I" & Rows.Count).End(xlUp).Row Step 2
                If r Is Nothing Then
                    Set r = shT.Cells(i, "I")
                Else
                    Set r = Union(r, shT.Cells(i, "I"))
                End If
            Next

            If Not r Is Nothing Then r.Delete

        End If

    End With

 End Sub

(β) 2016/06/23(木) 13:56


β様

うーん、ごめんなさい、フィルター結果が1行おきで貼り付けになってしまいます(/ _ ; )
(つまり現状はフィルター結果の偶数行目だけが一覧に
貼り付けになってます。)

ちょっと説明が分かりづらくてすみません。

フィルター結果を、一覧表の403行目、405行目、407行目、、、と
1行目あけて表示させたいです。

フィルター結果自体は1行おきじゃないです。

説明べたですみません
(かな) 2016/06/23(木) 15:11


こんにちは

こういう事でしょうか?

Sub 一覧作成()

    Dim k As Long
    Dim wk1 As Worksheet
    Dim wk2 As Worksheet
    Dim r   As Long
    Dim i   As Long

    Set wk1 = Sheets("フィルター用")
    Set wk2 = Sheets("一覧")
    With wk1
        .Range("I1").AutoFilter Field:=9, _
                          Criteria1:=65535, _
                          Operator:=xlFilterCellColor
        .Range("I2:I2000").SpecialCells(xlCellTypeVisible).Copy _
            Destination:=wk2.Cells(403, 5)
    End With
    Application.ScreenUpdating = False
    With wk2
        r = .Range("E" & Rows.Count).End(xlUp).Row
        For i = r To 403 Step -1
            .Range("E" & i + 1).Insert Shift:=xlDown
        Next
    End With
    Application.ScreenUpdating = True
End Sub

(ウッシ) 2016/06/23(木) 16:06


 そういうことですか。

 Sub Sample2()
    Dim shT As Worksheet
    Dim r As Range
    Dim i As Long
    Dim tmp As Variant
    Dim c As Range

    Set shT = Sheets("一覧")
    shT.Range("I403:I" & Rows.Count).ClearContents

    With Sheets("フィルター用")

        .AutoFilterMode = False
        .Range("A1").AutoFilter Field:=9, Criteria1:=vbYellow, Operator:=xlFilterCellColor

        If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then

            Intersect(.Range("A1").CurrentRegion, .Range("A1").CurrentRegion.Offset(1)).Columns("I").Copy shT.Range("I403")

            With shT.Range("I404", shT.Range("I" & Rows.Count).End(xlUp))
                ReDim tmp(1 To .Count)
                For i = 1 To .Count
                    tmp(i) = shT.Range("I" & i + .Row - 1).Address
                Next
            End With

            shT.Range(Join(tmp, ", ")).Insert

        End If

        .AutoFilterMode = False

    End With

 End Sub

(β) 2016/06/23(木) 17:52


ウッシ様
β様

私の拙い説明でコードを作成してくださりありがとうございます!

いま検証出来ませんので明日また試してみます!

お二人とも素早い対応ありがとうございます♪( ´▽`)
(かな) 2016/06/23(木) 18:14


コメント返信:

[ 一覧(最新更新順) ]


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