Excel2007：25行ごとにデータを抽出する関数は？

質問

Excel2007：25行ごとにデータを抽出する関数は？

先日、Excelについて質問させて頂き、アドバイスをいただいた者です。

Excel2007で請求書を作成しており、1請求書には25行13列を使っています。
2つ目の請求書は26行目から、3つ目は51行目から…という風に、
表の下に1請求書ごとに改ページを入れながら
次々と請求書をつなげて作っていっています。

このなかから、会社名と金額のみを取り出して、
同シートの請求書枠外に表として作りたいと思っています。

請求書は25行13列（A1:M25）
会社名はD5、D30、D55・・・・
金額はJ23、J48、J73・・・・

表を作りたい場所は、同シートのP1に会社名、Q1に金額とし、
1請求書につき1行で、次の請求書のデータをP2・Q2に入れたいです。

VBAではなく、関数を入れることで可能でしたら、関数で考えたいと思っています。
いろいろやってみたのですが、うまくいかず・・・

お詳しい方、どうぞよろしくお願い致します。

いちおう、前回助けていただいた質問のURLを載せます。
http://okwave.jp/qa/q6245060.html

回答No.2

fujillin · ベストアンサー

前回の回答者です。

前回の回答では、質問文から右側の列は使用していないと推測して、右側に並べ替えた表を作成し、元の列を削除するという処理になっています。
それなので、今回のご質問の関数と前回のVBAを併用すると、新しい表で上書きされたり、参照セルが変わってしまうということが起こってしまいます。

問題が起こらないように、前回の処理を帳票の位置が変わらないように修正いたしました。
（左側に作業用の列を挿入し、作業終了後削除するようにした）

また、参照するための関数はNo1様が既にご回答済みですが、連番の列が無くても可能ですのでご参考までに。
　P1に　=INDEX(D:D,ROW()*25-20)
　Q1に　=INDEX(J:J,ROW()*25-2)
として、あとは下にコピーフィルでいけると思います。

以下、VBAの修正版です。

Sub sample()
　Dim sht As Worksheet, rng As Range, rng1 As Range, rng2 As Range
　Dim sMax As Long, tmp, i As Integer, j As Integer

　Const sheet_rows = 25 ' 請求書１枚の行数
　Const sheet_columns = 13 ' 請求書１枚の列数
　Const target_row = 23 ' 金額が記入されている行
　Const target_column = 10 ' 金額が記入されている列
　Set sht = ActiveSheet

　sMax = 1
　For i = 1 To sheet_columns
　　tmp = sht.Cells(Rows.count, i).End(xlUp).Row
　　If tmp > sMax Then sMax = tmp
　Next i
　sMax = Fix((sMax + sheet_rows - 1) / sheet_rows)
　Set rng = sht.Cells(1, 1).Resize(sheet_rows, sheet_columns)

　rng.EntireColumn.Insert
　Set rng2 = rng.Offset(0, -sheet_columns)

　For i = 0 To 1
　　Set rng1 = rng
　　For j = 1 To sMax
　　　tmp = rng1.Cells(target_row, target_column).Value
　　　tmp = Replace(Replace(tmp, " ", ""), "　", "")
　　　If tmp = "" Then tmp = 0
　　　If (i = 0 And tmp > 0) Or (i = 1 And tmp = 0) Then
　　　　rng1.Copy rng2
　　　　Set rng2 = rng2.Offset(sheet_rows, 0)
　　　End If
　　　Set rng1 = rng1.Offset(sheet_rows, 0)
　　Next j
　Next i
　rng2.EntireColumn.Copy rng.EntireColumn
　rng2.EntireColumn.Delete
End Sub

お礼

度々のアドバイスをありがとうございます！

さっそく今、関数を入れました。
別の列に連番を入れなくても、出来るんですね。
またひとつ、活用できることが増えました！
ありがとうございます。

そして、前回教えていただいたVBAを修正して、実行してみました。

すごい！！
請求書も　後に入れた表も一気に並べ替えされました！（当たり前でしょうか…）
VBAを全然理解していない私には魔法のようです＾＾；

度々のご回答をいただいた上に、前回の内容にまで加えてのアドバイスをいただき、本当に助かりました。
ありがとうございました！

回答No.3

kagakusuki

まず、P2セルに次の数式を入力して下さい。

=IF(ROW(P1)>SUMPRODUCT(($D$1:$D$9999<>"")*(MOD(ROW($D$1:$D$9999),25)=ROW($D$5))),"",OFFSET($D$5,(ROW(P1)-1)*25,))

　次に、Q2セルに次の数式を入力して下さい。

=IF(ROW(Q1)>SUMPRODUCT(ISNUMBER($J$1:$J$9999)*(MOD(ROW($J$1:$J$9999),25)=ROW($J$23))),"",OFFSET($J$23,(ROW(Q1)-1)*25,))

　そして、P2～Q2の範囲をコピーして、同じ列の3行目以下に貼り付けて下さい。
　以上です。

　尚、枠外の表の行数が、請求書の枚数を超えている場合に、0が表示される事を、避ける必要性が無い場合には、入力する数式を次の様に簡略化する事も出来ます。

P2セルの数式

=OFFSET($D$5,(ROW(P1)-1)*25,)

Q2セルの数式

OFFSET($J$23,(ROW(Q1)-1)*25,)

お礼

アドバイスをいただきまして　ありがとうございます。

関数を入れてみましたら、できました！！
いろんな表記の方法があるんですね。
IF関数を使ってきちんと表を整えることも考えるというのが勉強になります。
式がすごく難しい感じなので、後ほどゆっくりどういう構造なのか考えてみます。

どうもありがとうございました！！

回答No.1

saintandre

INDEX関数を使ってみてはどうでしょうか？

R列には1,2,3,4,...と連番が振ってあるとお考えください
他に連番の列があるならばそちらでも結構です。

P列（会社名）1行目
　=INDEX(D:D,(R1-1)*25+5)
Q列（金額）1行目
　=INDEX(J:J,(R1-1)*25+23)

お礼

早々のアドバイスをいただきましてありがとうございます。
会社での作業なので、お礼が遅くなりすみません。

さっそく今やってみましたらできました！！

別の列に連番を振る　というのは思いもよりませんでした。

INDEX関数についても、よく調べてみようと思います。

活用させて頂きます。
ありがとうございました！！