Excel2007：ブロック単位での抽出について

質問

Excel2007：ブロック単位での抽出について

エクセルで請求書を作成しています。

1件の請求書には25行13列を使っています。
25行ごとに改ページを入れており、
次々に請求書をたして行っている状態です。

1か月に1シートとしており、
次月は当月シートをコピーして
金額や日付のみを変更していっています。

毎月同じ取引先へ請求があればよいのですが、
どの取引先も月によって請求があったりなかったり…という状況ですので、

請求がない相手先については請求額０円で請求書が残りますが、
削除してしまうと、次月にコピーされなくなってしまうので、0円のまま残しています。

以上のような処理をしているため、
シートの中で　金額のある請求書と0円の請求書がランダムに並んでしまっている状態です。

このなかから、金額のある請求書だけを抽出することは可能でしょうか？

金額のある請求書を上に持ってきて、0円の請求書を下に持っていく・・というのが理想ですが、
難しければ、抽出して金額のある請求書だけのシートを作成する　という事でもかまいません。

わかりづらい説明で申し訳ありませんが、うまい方法がありましたら、教えていただきたいです。

どうぞよろしくお願いします。

回答No.1

fujillin · ベストアンサー

VBA（マクロ）で可能かと。

内容がはっきりしていないのであくまでもサンプルですが、こんな感じ？
一行、一列目から請求書の1ページが始まっていると仮定しています。
（金額があるセルを、請求書の3行4列目と仮に設定）
金額欄が数字であることなどのチェックは行なっていません。
（無記入、スペースのみ、0などを金額0と判断しています）

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 = 3 ' 金額が記入されている行
　Const target_column = 4 ' 金額が記入されている列
　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)
　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
　rng.Resize(Rows.count, sheet_columns).Delete
End Sub

お礼

fujillinさん

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

教えていただいた通りにやってみましたら、できました！！
ほんとに助かりました。
ありがとうございます。

VBAって難しそうですが　私も勉強してみようと思います。

ほんとにほんとに　ありがとうございました！！！