[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『キーの下5行まで抽出』(ROONEY)
昔の質問の、応用編です。。
[[20160419151536]] 『キーの下5行まで抽出』(ROONEY)
Sub main()
'こちらがベターか? Dim rg As Range, c As Range Sheets("Sheet2").Cells.ClearContents Set rg = Sheets("Sheet2").Range("A1").Resize(, 5) For Each c In Sheets("Sheet1").UsedRange.Columns(1).Cells If Not IsError(c) Then If c.Value = "住所" Then c.Resize(5).Copy rg.PasteSpecial Transpose:=True Set rg = rg.Offset(1) End If End If Next c End Sub
上記の構文に、条件追加をしたいです。当初は、「住所」があった場合、「住所」のセルから下5つを抽出。でしたが、同じデータ内に、「住所」のセルの隣のセル(例:A1セルに住所があれば、B1セル)に情報が記載されている場合もありました。よって、条件追加で、隣のセルから下5つを抽出。も付け加えていただけないでしょうか?
どうぞよろしくお願いいたします。
< 使用 Excel:Excel2016、使用 OS:Windows10 >
(γ) 2016/10/19(水) 14:39
回答ではありませんが、昔の質問・回答をコピペして非常に見辛かったので 勝手ながら修正しました。次からは「参照登録」をクリックして質問してください。
※誰か知らないけど人のコメント勝手に削除しないで。 (bi) 2016/10/19(水) 14:40
Sub main2() Dim rg As Range, c As Range
Sheets("Sheet2").Cells.ClearContents Set rg = Sheets("Sheet2").Range("A1") '(1) For Each c In Sheets("Sheet1").UsedRange.Columns(1).Cells If Not IsError(c) Then If c.Value = "住所" Then c.Resize(5, 2).Copy rg.PasteSpecial Transpose:=True Set rg = rg.Offset(2) '(2) End If End If Next c End Sub
補足: (1)のところは、貼付領域の左上の一つのセルを指定するだけでOKです。 (2)は、次の書込先を予め指定する部分です。 転置しているので、2行5列の領域が書き込まれますが、 連続した領域に書き込むなら、2行進めておくし、 間に一行入れたい、ということなら、3行進めたらよいでしょう。
(γ) 2016/10/19(水) 19:27
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.