エクセルVBA 日付で抽出、並び替え

質問

こういう場で初めて質問させていただきます。
どうぞよろしくお願いします。

エクセルVBAで日付（月毎）でデータを抽出し、並び替えを行いたいのですが,

B列に日付が入りC～F列には帳簿の仕訳が入ります。

ここで　B2　に日付が入って、C2～F2とC3～D3にデータが入った場合に
オートフィルタをかけたら、3行目は日付の欄が空白なので
うまく抽出できません。

なお、2行目と3行目は1つの仕訳なのでばらばらになるのも困ります。

仕訳は最低1行から最大で6行になります。

このように日付欄は1行だけど、その日付に対応する内容が数行に渡って入るような場合に日付から月毎にデータ抽出するには
どのようなコードを書けばいいのでしょうか？

A　B　　　　C　　　　　 D　　　　　E　　　　F
　日付　借方科目　金額　貸方科目　金額
　10/10　消耗品　 300　　　 現金　　　500
　　　　　　 雑費　　 200
　 10/9 　 交際費　 500 　　 現金　　　500
　 10/8 　 　雑費 　 200 　 　 現金　　　200
汚い表ですが、上記のような場合です。
10/10の分は2行で1つになりますので、このような場合です。

どうかよろしくご指導お願いします。

回答No.5

kMashiMash

こんなのどうでしょう。
試してみるときはメモ帳などのテキストエディタで全角スペースを半角スペースに変えてから試してみてください。

Sub　仕分け分割()

　　　　'使うフラグを宣言
　　　　Dim　借方が空白フラグ　As　Boolean
　　　　Dim　貸方が空白フラグ　As　Boolean

　　　　'配列を宣言する
　　　　Dim　日付()　As　String
　　　　Dim　借方勘定()　As　String
　　　　Dim　借方金額()　As　Integer
　　　　Dim　貸方勘定()　As　String
　　　　Dim　貸方金額()　As　Integer

　　　　'C列とE列の最終行を求める
　　　　C列の最終行　=　Cells(65536,　3).End(xlUp).Row
　　　　E列の最終行　=　Cells(65536,　5).End(xlUp).Row

　　　　'C列とE列のいずれかの大きいほうを最終行とする。
　　　　If　C列の最終行　>　E列の最終行　Then
　　　　　　　　最終行　=　C列の最終行
　　　　ElseIf　E列の最終行　>　C列の最終行　Then
　　　　　　　　最終行　=　E列の最終行
　　　　ElseIf　C列の最終行　=　E列の最終行　Then
　　　　　　　　最終行　=　C列の最終行
　　　　End　If

　　　　'要素数がわかったので配列を再定義する
　　　　ReDim　日付(最終行　+　1)
　　　　ReDim　借方勘定(最終行　+　1)
　　　　ReDim　借方金額(最終行　+　1)
　　　　ReDim　貸方勘定(最終行　+　1)
　　　　ReDim　貸方金額(最終行　+　1)

　　　　'配列にセルの情報を入れてしまう。このとき日付を満たしてやる。
　　　　For　i　=　2　To　最終行
　　　　　　　　If　Cells(i,　2).Value　Then
　　　　　　　　　　　　日付(i)　=　Cells(i,　2).Value
　　　　　　　　Else
　　　　　　　　　　　　日付(i)　=　日付(i　-　1)
　　　　　　　　End　If
　　　　　　　　借方勘定(i)　=　Cells(i,　3).Value
　　　　　　　　借方金額(i)　=　Cells(i,　4).Value
　　　　　　　　貸方勘定(i)　=　Cells(i,　5).Value
　　　　　　　　貸方金額(i)　=　Cells(i,　6).Value
　　　　Next　i

　　　　'2行目以降から1行ずつi行目をこのように見ていく
　　　　For　i　=　2　To　最終行

　　　　　　　　'借方と貸方の金額が合っていたら、そのままH列から始まる分割された仕訳に転記
　　　　　　　　If　借方金額(i)　=　貸方金額(i)　Then
　　　　　　　　　　　　Cells(i,　8).Value　=　日付(i)
　　　　　　　　　　　　Cells(i,　9).Value　=　借方勘定(i)
　　　　　　　　　　　　Cells(i,　10).Value　=　借方金額(i)
　　　　　　　　　　　　Cells(i,　11).Value　=　貸方勘定(i)
　　　　　　　　　　　　Cells(i,　12).Value　=　貸方金額(i)
　　　　　　　　End　If

　　　　　　　　'借方と貸方の金額が違っていたら...
　　　　　　　　If　借方金額(i)　<>　貸方金額(i)　Then
　　　　　　　　　　　　'フラグを初期化
　　　　　　　　　　　　借方が空白フラグ　=　0
　　　　　　　　　　　　貸方が空白フラグ　=　0

　　　　　　　　　　　　'チェック機能として貸方と借方の合計金額が合うかどうか調べる
　　　　　　　　　　　　借方金額合計　=　借方金額(i)
　　　　　　　　　　　　貸方金額合計　=　貸方金額(i)

　　　　　　　　　　　　'借方勘定か貸方勘定の次の行が空白のはず
　　　　　　　　　　　　If　借方勘定(i　+　1)　=　""　Then
　　　　　　　　　　　　　　　　借方が空白フラグ　=　1
　　　　　　　　　　　　ElseIf　貸方勘定(i　+　1)　=　""　Then
　　　　　　　　　　　　　　　　貸方が空白フラグ　=　1
　　　　　　　　　　　　End　If

　　　　　　　　　　　　'何行空白が続くのかカウントするための変数
　　　　　　　　　　　　j　=　1

　　　　　　　　　　　　'仕訳のチェック開始
　　　　　　　　　　　　If　借方が空白フラグ　Then
　　　　　　　　　　　　　　　　While　借方勘定(i　+　j)　=　""　And　最終行　>=　i　+　j
　　　　　　　　　　　　　　　　　　　　貸方金額合計　=　貸方金額合計　+　貸方金額(i　+　j)
　　　　　　　　　　　　　　　　　　　　j　=　j　+　1
　　　　　　　　　　　　　　　　Wend
　　　　　　　　　　　　ElseIf　貸方が空白フラグ　Then
　　　　　　　　　　　　　　　　While　貸方勘定(i　+　j)　=　""　And　最終行　>=　i　+　j
　　　　　　　　　　　　　　　　　　　　借方金額合計　=　借方金額合計　+　借方金額(i　+　j)
　　　　　　　　　　　　　　　　　　　　j　=　j　+　1
　　　　　　　　　　　　　　　　Wend
　　　　　　　　　　　　ElseIf　借方が空白フラグ　=　0　And　貸方が空白フラグ　=　0　Then
　　　　　　　　　　　　　　　　MsgBox　"借方と貸方の金額が合わず、次の行もどちらも空白ではありません。この条件でさらに計算する場合はプログラムを足してください"
　　　　　　　　　　　　　　　　MsgBox　"プログラムを終了します。"
　　　　　　　　　　　　　　　　Exit　Sub
　　　　　　　　　　　　ElseIf　借方が空白フラグ　=　1　And　貸方が空白フラグ　=　1　Then
　　　　　　　　　　　　　　　　MsgBox　"借方と貸方の金額が合いませんが、これ以上データがないので終了します。"　&　i　&　"行目をご確認ください。"
　　　　　　　　　　　　　　　　Exit　Sub
　　　　　　　　　　　　End　If

　　　　　　　　　　　　'仕訳の合計金額が右と左で合うかチェック
　　　　　　　　　　　　If　借方金額合計　<>　貸方金額合計　Then
　　　　　　　　　　　　　　　　MsgBox　i　&　"行目から始まる仕訳。借方金額と貸方金額の合計が合いません。仕訳を確認してください。プログラムを終了します。"
　　　　　　　　　　　　　　　　Exit　Sub
　　　　　　　　　　　　End　If

　　　　　　　　　　　　'ｊは実際に空白だった行数より１多いので引いてやる
　　　　　　　　　　　　j　=　j　-　1

　　　　　　　　　　　　'仕訳の分割開始
　　　　　　　　　　　　If　借方が空白フラグ　Then
　　　　　　　　　　　　　　　　For　k　=　i　To　i　+　j
　　　　　　　　　　　　　　　　　　　　Cells(k,　8).Value　=　日付(k)
　　　　　　　　　　　　　　　　　　　　Cells(k,　9).Value　=　借方勘定(i)
　　　　　　　　　　　　　　　　　　　　Cells(k,　10).Value　=　貸方金額(k)
　　　　　　　　　　　　　　　　　　　　Cells(k,　11).Value　=　貸方勘定(k)
　　　　　　　　　　　　　　　　　　　　Cells(k,　12).Value　=　貸方金額(k)
　　　　　　　　　　　　　　　　Next　k
　　　　　　　　　　　　ElseIf　貸方が空白フラグ　Then
　　　　　　　　　　　　　　　　For　k　=　i　To　i　+　j
　　　　　　　　　　　　　　　　　　　　Cells(k,　8).Value　=　日付(k)
　　　　　　　　　　　　　　　　　　　　Cells(k,　9).Value　=　借方勘定(k)
　　　　　　　　　　　　　　　　　　　　Cells(k,　10).Value　=　借方金額(k)
　　　　　　　　　　　　　　　　　　　　Cells(k,　11).Value　=　貸方勘定(i)
　　　　　　　　　　　　　　　　　　　　Cells(k,　12).Value　=　借方金額(k)
　　　　　　　　　　　　　　　　Next　k
　　　　　　　　　　　　End　If

　　　　　　　　　　　　'進んだ行数分iを足してやる
　　　　　　　　　　　　i　=　i　+　j
　　　　　　　　End　If
　　　　Next　i

End　Sub

お礼

ご回答ありがとうございます。
とても参考になりまた、大変勉強になりました！

回答No.4

imogasi

質問文は長いが、人間界の意味では、上と同一という意味で空白にしている行がある。それをその列でソートしたい、ということらしい。
こんなのは、そのままではどうしようもない。
ーー
エクセルのソートは、シートのセルに実際あるデータで並べ替えるのだ。空白は上の行と同じと解釈してくれ（データ）とか、１と２は同じと看做して並べ替えろ（ルール）など、要求を満たすようにはなってない。前者はMS社がその気になれば簡単に実現するだろう。
現にユーザー定義で並べ替えるという、前者以上の機能がエクセルにはあるから。
後者はルールのタイプが予想しにくく難しいだろう。
グラフを描かせるにも実データがシート状に整理されて存在しないと
描いてくれない。
ーーー
エクセルの経験を少しつめばそんなことは判るはず。
エクセルには、２００３までは、リスト形式、リスト機能（２００３）その後は「テーブル」とかの考えがあって
その要件の１つに、ある列や行を空白にしておくな、というルールがある。それは解説本などには載っている。
（基本的な考えとしての）リスト形式
http://kokodane.com/kihon8.htm
リスト機能（２００３）
http://allabout.co.jp/computer/msexcel/closeup/CU20080605A/
VBAはエクセルを良く知らない人があるものではない。
＝＝＝＝
ですから、手間でもこういうデータ入力をやめるのが肝心。
VBAで日付列の空白セルに正しい日付を入れる。
関数ででも、またはVBAでも別に全行日付で埋まった作業列を作る。
しかない。

回答No.3

kMashiMash

会計業務ですね。
経験はありませんが簿記の記憶が久しぶりによみがえってきました。
もうそのB列を日付で埋めてしまうのはどうでしょう。
後々の仕分けの為に。。。

たとえばG2に
=if({B2<>"")B2,b1)
という式を作って、G列に必要な行数だけコピーぺでもいいですしフィルでだだだってG列を埋めてやってもいいと思います。
G列をコピーしてB列に全部コピー。。。

これならB列にすべて日付が入った事になると思います。
これなら集計や仕分けが楽チンです。日付が全部埋まっ他状態のデータになっているのですから。
日付ごとのデータを集計するのにも使えるでしょうね。

言いたいことがきちんと伝わったかどうかわかりませんが、一応投稿させていただきました。

お礼

返答ありがとうございます。

たりない情報があるなら、それを作りだせばいいんですよね。
B列を日付で埋めてしまう、G列を使って日付欄を作りそこを参照させる。
教えていただいた考え方を今後活かしていきたいと思います。

ありがとうございました。

回答No.2

rivoisu

こういう複合仕訳はそのままではコンピュータ処理に合いません。
例えば日付を加えても元帳を作るときに「相手科目」をどうするかということになるので、
いったん単一仕訳に（相手科目を諸口などにして）変換します。
表示、入力は複合仕訳でも、そのあとデータを保存したり集計したりするためには単一仕訳に変換したデータを持つ必要があると思います。
上記のデータは諸口を使わなくとも変換できますが、給与の仕訳などどうしても単純に分割できない仕訳もあります。

お礼

さっそくの返答ありがとうございます。
おっしゃる通り、このあとの処理を考えたら単一仕訳に変換した方が
よさそうなので、いったん単一仕訳に変換する方法を考えたいと思います。
ありがとうございました。

回答No.1

bin-chan

「抽出用に日付列を設ける」ではいかがでしょう？

列Bに日付があるんですかね？列Fまで使用している？

列Gを使うとします。
セルB2に、仕分一件目があるとします。
セルG2に式[=B2]を入力。（下のセルＧ３を先に設定してコピーするも良し）
セルG3に式[=if(b3="",g2,b3)]を入力。
セルG3を「コピー」して列Gの最終行まで選択(Ctrl+Shift+End)して「貼り付け」。
で、列Ｇにオートフィルタを設定。

お礼

さっそくの返答ありがとうございます。
G列を使うといった方法があったのですね。
こういう考え方を自分のものにできるように努めていきます。

ありがとうございました。