[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『フィルター結果を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
何度もすみません!
(かな) 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.