gooポイントが当たる質問投稿キャンペーン>>

エクセル2013を使ってPTAの会計処理をしています。
予算書、出納帳、決算書、特に出納帳の科目を条件にしてSUMIF関数を使って決算に自動記入出来ました。
科目別の明細はオートフィルターを使ってコピペしていたのですが、科目数も多くなり(40を超えて)行数も多くなり(200行超えてます)、自動で出来ないかと思い、過去ログ等を頼りにVBAを書いてみたのですが、うまく動作しません。

出納帳の1行目に見出しを入れて、2行目から日々の入出金、最後に収入合計、支出合計、残額の行を設けてあります。
   A  B  C   D  E    F   G   H    I
1 月日 分類 小分類 No. 摘要   収入  支出  残高   科目
2 4/1 本部  運営  1  前年度 100,000  0  100,000 前年度繰越金
3 4/2 委員会 事業  2  会議     0  900  99,100 会議費

                合計 ***,*** ***,*** ***、***
となっています(画面ではズレているでしょう)
このI列の科目毎に明細表を作りたいのです。

ここの過去ログで下記のようなVBAを見つけ、やってみました。
教えていた方の話では、
K列に「抽出条件の見出しと最初の科目名」
M列に「抽出条件の見出しと(抽出したい?)全科目名」
N列に「科目毎のシートの名称」
を記入して、と有った(実際の返答を列数を増やしました)ので、そのようにしました。

Sub FilterDataCopy()

Dim MyRow As Long 'G列の行を入れる変数

Application.ScreenUpdating = False
MyRow = 2

'まず前日の抽出データを全てクリア
Do Until Sheets("出納帳").Cells(MyRow, "M") = ""
Sheets(Sheets("出納帳").Cells(MyRow, "N").Text).Select
Cells.Select
Selection.ClearContents
MyRow = MyRow + 1
Loop

Sheets("出納帳").Activate
MyRow = 2
'抽出してコピー
Do Until Cells(MyRow, "M") = ""
Range("K2") = Cells(MyRow, "M")
Range("A2").CurrentRegion.AdvancedFilter xlFilterCopy, Range("K1:K2"), Sheets(Cells(MyRow, "N").Text).Range("A2")
MyRow = MyRow + 1
Loop

Application.ScreenUpdating = True

End Sub

これで動かしたところ、各タブに1行目の見出しは書き出される(タイトルを入れる都合でA2からにしています)のですが、その下の実際の入出金が記載されないのです。
どのように修正したら良いのか?お教えいただけますでしょうか?
修正ではなく、新規でも構いません。

本当は、各科目の最終行に合計を入れたいのですが、それは可能ならで構いません。(^^;)
それに印刷することを考えると、行数が少なく終わってしまうモノも有りますので、少ないシート数に出来たらうれしいですが、そのくらいはコピペ出来ると思いますので(^^;)
お知恵をいただけないでしょうか?

質問者からの補足コメント

  • うーん・・・

    アドバイスありがとうございます。時間の都合と試行錯誤で遅くなりましたm(__)m
    ピボットテーブル試してみました。「収入支出」が合計で表示されるのは良いのですが、他の「月日」や「分類」「摘要」等が1行で表示されません。
    私の設定の仕方が悪いのかと色々やってみたのですが、やればやるほど見づらくなってしまいました(^^;)

    No.2の回答に寄せられた補足コメントです。 補足日時:2016/04/28 19:03
  • へこむわー

    さらなるアドバイスありがとうございます。時間の都合と試行錯誤で遅くなってしまいましたm(__)m
    修正をしてやったのですが、何も表示されませんでした。
    あ、教えていただいたコードの「データ」は実際に合わせて「出納帳」と修正しました。
    そこで、別に簡単な表を作り、動かしてみたのですが、そちらではちゃんと表示されました。
    表の違いは、行数が違うこととセルに記入された単語?そして空白セルの有り無しくらいなんですが・・・

    フィルターを手動でやったら、出来たのですが・・・(;´・ω・)

    No.3の回答に寄せられた補足コメントです。 補足日時:2016/04/28 19:17
  • へこむわー

    再度ありがとうございます。
    私が勘違いしていたようです。(^^;)
    「手動でフィルターを掛けたら出来ました」というのは、単にその表にフィルターを
    掛けたことで、ご教示いただいたページの様にやってみたところ、1行目の「月、分類・・・」が表示されるだけでその下は何も表示されませんでした。
    行数が多いのか?(そんなことはないと思いますが)と思い、例題と同じ13行くらいを範囲指定してみましたが、1行目しか表示されません。
    例題の表と見比べても、当然違いが判りません。あえて言えば、こちらには空白セルが有るくらいでしょうか。
    なんか深みにハマってきました(;_;)

    No.5の回答に寄せられた補足コメントです。 補足日時:2016/04/29 12:52
  • うーん・・・

    ありがとうございます。

    「月、分類・・・」は質問に書いた元データ(出納帳というシート名)の
       A  B  C   D  E    F   G   H    I
    1 月日 分類 小分類 No. 摘要   収入  支出  残高   科目
    この行のことです(^^;)
    マクロを実行して、表示されるのは
       A  B  C   D  E    F   G   H    I
    1    科目
    2   (リスト表示される科目)


    5 月日 分類 小分類 No. 摘要   収入  支出  残高   科目
    で、6行目からには何も表示されないんです。

    はい、シートを右クリックの「コード表示」から書き込んでます。

    No.6の回答に寄せられた補足コメントです。 補足日時:2016/04/29 15:11
  • わざわざやっていただきありがとうございます。

    「マクロ実行中」とメッセージボックスが出ました!!

    でも、表示は1行目だけです。

    No.7の回答に寄せられた補足コメントです。 補足日時:2016/04/29 16:22
  • どう思う?

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

    試しに選択したモノはちゃんとデータのあるやつです(^^;)
    そして、空白にすると、「全てのデータ」が表示されました。

    ちなみに、列はそのまま、行は13行、データは不規則な表でやってみたらちゃんと表示されたのですが、データを今回の表からコピペしたらダメでした。
    データ自体に問題が有るってことでしょうか?

    No.8の回答に寄せられた補足コメントです。 補足日時:2016/04/29 18:08
  • へこむわー

    科目の列には空白は無いです。
    他の列には空白が有りますが。

    出納帳シートの表の科目を一つコピーして貼り付けしても、今までと同じで1行目だけの表示でした。

    No.9の回答に寄せられた補足コメントです。 補足日時:2016/04/29 19:08

このQ&Aに関連する最新のQ&A

pta 会計」に関するQ&A: PTA会計・会計監査

A 回答 (9件)

質問に対する直接の回答でなくて失礼します。


1、各科目ごとに40枚のシートが必要ですか?
2、最終行に合計を入れると下の方で位置もバラバラですよ。
私であれば
1、データの抽出シートを1枚
  K2に科目をドロップダウンリストから選択したら
  希望の科目の明細が下に表示する。
2、合計金額は上部分の固定した位置に表示させる。

参考までに、先日回答したサイトを紹介しておきます。
https://oshiete.goo.ne.jp/qa/9249567.html
仮に、別シートに
   A  B  C   D  E    F   G   H
1     科目             収入計 支出計
2     会議費            
3
4
5 月日 分類 小分類 No. 摘要   収入  支出  残高

とB2に希望する科目(入力規則を設定して、ドロップダウンで選択)
シートモジュールを開いて
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
Sheets("データ").Columns("A:I").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("B1:B2"), CopyToRange:=Range("A5:H53"), Unique:=False
End If
End Sub

B2セルを変更するだけで、ご希望の科目の明細が6行目以下に表示されます。

シートを移動して希望する科目を探すより
ドロップダウンリストで探す方が楽ですよ。
    • good
    • 0
この回答へのお礼

アドバイスありがとうございますm(__)m
1は表現が下手ですみません。
「各科目ごとに40枚のシート」ではなく、1科目は1枚です。
科目が40くらい有るので、1科目1シートで、Book全体で40シート位になってしまう、ということです。
2の「合計を上部で固定」ですが、帳面に記帳した際の見た目を重視してしまいました。
文字サイズ等を変更して、見やすいようにすればいけますね(^_^;)

ご教授いただいたコードを新規のシートのタブで右クリックして貼り付けました。
「データ」を「出納帳」に修正しました。
しかし、6行目以下に何も表示されないのですが・・・???

科目ごとにシートを作った方が良いと思ったのは、私ではない者(後任)が作業したときに、その方が印刷する際にコピペしやすいかなと思ったからなんです(^_^;)

表示されない点等、お分かりになりますでしょうか?

お礼日時:2016/04/22 01:32

>データを今回の表からコピペしたらダメでした。


例えば、科目のデータに 空白がとか何かが含まれているとかは?
科目の一つをコピー
B2セルに張り付けてみては如何??
この回答への補足あり
    • good
    • 1
この回答へのお礼

出来ました!!
今日再度詳細を確認しました。
問題なく抽出できた(マクロが動いた)試しに作った表と実際に使いたい表と見比べてみました。すると、抽出条件にする「科目」が「科 目」でした。(;´・ω・)
今後引き継いでもらう方のことも考えて、ファイルを用意したいと思います。
親身にお付き合いいただき、本当にありがとうございました。

お礼日時:2016/04/30 11:21

>「マクロ実行中」とメッセージボックスが出ました!!


と云う事でしたら
Sheets("出納帳").Columns("A:I").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("B1:B2"), CopyToRange:=Range("A5:I5"), Unique:=False
は実行されていますが
B2セルに入力されている 科目に該当するデータが一件もないという事はないですよね。
もうひとつ試して
B2セルを空白にしたら全てが表示されると思うのですが

>ご教示いただいたページの様にやってみたところ、1行目の「月、分類・・・」が表示され
>るだけでその下は何も表示されませんでした。
フィルターオプションの操作を行っても希望のデータが抽出されないという事ですね。
まずは、ここをクリアする必要があるかも??
この回答への補足あり
    • good
    • 0

こちらでも同じようなエクセルファイルを作成し実行しましたが


出来ました。
ちなみに
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
MsgBox "マクロ実行中"
Sheets("出納帳").Columns("A:I").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("B1:B2"), CopyToRange:=Range("A5:I5"), Unique:=False
End If
End Sub
と途中にMsgbox で表示する行を追加してみましたが

B2セルの内容を変更したら、 マクロ実行中 と 表示が出ますか?
この回答への補足あり
    • good
    • 0

今日は暇なのでお付き合いします。


現在のシートの状況を説明してもらえませんか
>1行目の「月、分類・・・」が表示されるだけでその下は何も表示されませんでした。
先の例では
1行目、2行目に抽出の条件です。
元データに月という項目があるのでしょうか。

先に紹介したコードはシートモジュールに記載します。
シート名を右クリックして、コードの表示をクリック
VBエディターが起動したら、そのシートのシートモジュールになります。
この回答への補足あり
    • good
    • 0

>フィルターを手動でやったら、出来たのですが・・・(;´・ω・)


だったら
マクロの記録
フィルターを手動でやったら
記録の終了

これで作成されたコードと現在のコードの違いを確認しましょう

If Target.Address = "$B$2" Then
の部分で、B2セルの内容が変更されたら
実行するという事を指定したいますが
この回答への補足あり
    • good
    • 0

横から失礼します。

後任に引き継ぐのであれば、あまり凝らない方が良いかと・・・。
そこで、次のような手順ではいかがでしょうか?こうしておけば、手作業のコピペも楽だと思います。

①元シートをコピーして”明細”シートを作成します。以下、”明細”シートでの作業です。
②科目で並べ替えます。
③科目をキーに、小計を設定します。「グループ毎に改ページを挿入」にすれば、印刷時に改ページもできます。
    • good
    • 0
この回答へのお礼

貴重なアドバイスありがとうございます。
そうですね、今後科目名が変わったり増えたり減ったりすることも有りえますので、マクロだと敷居が高いかもしれません(^^;)
私はこれで楽させてもらいます(爆)が、引き継ぐのは別にした方が良さそうです。
ありがとうございました。m(__)m

お礼日時:2016/04/30 11:25

NO1です。


>しかし、6行目以下に何も表示されないのですが・・・???
すみませんでした。
CopyToRange:=Range("A5:H53"), Unique:=False

CopyToRange:=Range("A5:H5"), Unique:=False
ですね。
後はB2セルを変更することでVBAが実行されると思います。
フィルターオプションの機能ですが
http://www.eurus.dti.ne.jp/~yoneyama/Excel/filte …
の辺りを参考に一度、手動で抽出してみてください。
この回答への補足あり
    • good
    • 0

ピボットテーブル試してみましたか?


http://allabout.co.jp/gm/gc/297727/

出納長のシートにおいて
[Ctrl]+[F3]名前の定義
名前 : PT範囲_出納
参照範囲 : =$A$1:INDEX($I:$I,COUNTA($A:$A))

ピボットテーブルの範囲を
=PT範囲_出納
とすることでピボットテーブルの範囲が可変になり
ピボットテーブル更新時に計算してくれます。

とりあえず、科目を行フィールド
収入と支出をデータフィールド
「データ」となりますので列フィールドにドラッグ
とか 科目をページフィールドにドラッグする
とか 合計/支出 の金額のセルをダブルクリックしてみるなんてのも
この回答への補足あり
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Q(EXCEL)出納帳に科目別シートを作成したい

添付の画像のような出納帳を作成しています。

「出納帳シート」の『相手科目』は、入力規則のリストを使用して、《リストシート》より選択するように設定しました。

今回は、この『相手科目』をそれぞれ別々のシートに分けて、自動的に集約・合計されるようなものを作成したいと思っております。

Webを検索してみるとVBAを使用する必要があるとの内容を拝見したのですが、自分のExcelファイルに導入する際、どこを書き換えれば良いのか分らず、行き詰まってしまいました。

関数を使用しても、VBAを使用しても良いのですが、VBAについてはあまり知識がありませんので、初心者向けに教えて下さると助かります。

面倒なお願いで申し訳ないのですが、よろしくお願い致します。

Aベストアンサー

>関数を使用しても、VBAを使用しても良いのですが
関数で対応できます。
ご提示の画像が判読できない状態です。
B5は需用費と読めますがそれで良いでしょうか?
また、費目別のシートへ抽出する項目は日付、摘要、入金、出金で良いでしょうか?
日付については下記の数式で良いと思います。
=IF(COUNTIF(出納簿!$B$5:$B$1000,"需用費")>=ROWS(A$5:A5),INDEX(出納簿!A:A,SUMPRODUCT(SMALL((出納簿!$B$5:$B$1000="需用費")*ROW(A$5:A$1000)+(出納簿!$B$5:$B$1000<>"需用費")*10^9,ROWS(A$5:A5))),1),"")
摘要はINDEX関数の出納簿!A:Aを出納簿!C:Cに置き換えれば目的に合います。
=IF(COUNTIF(出納簿!$B$5:$B$1000,"需用費")>=ROWS(A$5:A5),INDEX(出納簿!C:C,SUMPRODUCT(SMALL((出納簿!$B$5:$B$1000="需用費")*ROW(A$5:A$1000)+(出納簿!$B$5:$B$1000<>"需用費")*10^9,ROWS(A$5:A5))),1),"")
入金および出金は摘要を右へコピーすれば良いでしょう。
1行分の数式が確定したら纏めて下へ必要数コピーすれば完了です。
提示の数式は元データ(出納簿)の最大行番号を1000にしてありますので必要に応じて増減してください。
計算結果で0が表示されるセルが見難い場合は条件付き書式で0の場合はフォントの色を白にしてください。

他の費目シートについては需用費シートをシート全体をコピーして、費目の文字列を置換すれば良いでしょう。

>関数を使用しても、VBAを使用しても良いのですが
関数で対応できます。
ご提示の画像が判読できない状態です。
B5は需用費と読めますがそれで良いでしょうか?
また、費目別のシートへ抽出する項目は日付、摘要、入金、出金で良いでしょうか?
日付については下記の数式で良いと思います。
=IF(COUNTIF(出納簿!$B$5:$B$1000,"需用費")>=ROWS(A$5:A5),INDEX(出納簿!A:A,SUMPRODUCT(SMALL((出納簿!$B$5:$B$1000="需用費")*ROW(A$5:A$1000)+(出納簿!$B$5:$B$1000<>"需用費")*10^9,ROWS(A$5:A5))),1),"")
摘要はINDEX...続きを読む

Qエクセルで打ち込んだ数字を自動で別シートに表示したい

エクセルでセルに打ち込んだ数字を自動で別シートに表示できる方法があれば、教えてください。

例えば、シート1のC1に5を打ち込んだら、シート2のD2にシート1で打ち込んだ5が自動で表示される。

また1列すべてを自動で表示させる場合、一つのセルの時と違いがありましたら教えてください。よろしくお願いします。

Aベストアンサー

こんばんは。
入力したセルの値を合計とかでなくて、
純粋に別のシートに自動的に表示したいのであれば、
以下の方法があります。

1.1つのセルだけの場合
例)シート1のC1に5を打ち込んだら、
  シート2のD2にシート1で打ち込んだ5が自動で表示される

⇒シート2のD2のセルをアクティブにして「=」を入力
 した後、シート1のC1をクリックする。
 そうするとD2のセルに「=Sheet1!C1」と表示され、値が自動的に
 表示されるようになります。

2.1列全てコピーしたい場合。
  コピー&リンク貼り付けを使うと便利です。

例)例)シート1のC1~C5に何かを入力したら、
  シート2のD2~D7にシート1で打ち込んだものが自動で表示される

  シート1にあるコピー元のセルを範囲選択して、
  シート2のD2の上で「右クリック」⇒「形式を選択して貼り付け」
  をクリックします。

  そして出てきた小さな画面の左下にある「リンク貼り付け」という
  ボタンをクリックすると完成です。
  試してみてください。。

  念のためにリンク貼り付けを図解しているURLを載せておきます。
  参考にしてみてくださいね。。
  http://www.geocities.jp/office_inoue/excel/eq21.htm

こんばんは。
入力したセルの値を合計とかでなくて、
純粋に別のシートに自動的に表示したいのであれば、
以下の方法があります。

1.1つのセルだけの場合
例)シート1のC1に5を打ち込んだら、
  シート2のD2にシート1で打ち込んだ5が自動で表示される

⇒シート2のD2のセルをアクティブにして「=」を入力
 した後、シート1のC1をクリックする。
 そうするとD2のセルに「=Sheet1!C1」と表示され、値が自動的に
 表示されるようになります。

2.1列全てコピーしたい場合。
  コ...続きを読む

Qエクセルの1シートを項目別に別シートへ分ける方法

エクセル2010で1シートのデータを項目別に別シートへ自動的に分割する方法で困っています。
検索するとマクロを使うと書いていますが、マクロはほとんど使ったことが無いのもあって、わかりませんでした。

シート1
A列(日付8ケタ+商品番号6ケタ) B列(売上額)
20130515000004           300
20130515000006           100
20130518000004           300
20130519000001           500
20130519000004           300
・・・                   ・・・
をA列の日付部分上8ケタを使って日別にシートを分け、
シート名をuriage20130515(uriageと日付8ケタ)という名前にしシート名+CSV形式で保存したいです。

シート2 シート名:uriage20130515
A列         B列
20130515000004 300
20130515000006 100

シート3 シート名:uriage20130518
A列         B列
20130518000004 300

シート4 シート名:uriage20130519
A列         B列
20130519000001 500
20130519000004 300

このように自動で別シートに分割した上で、シート名CSV形式で保存まで自動でできるとありがたいです。

自動化できるならシートを分割するマクロ、シート名でCSV保存するマクロが一つのマクロになっていても、分かれていてもOKです。

このようなことはできますか?

よろしくお願いします。

エクセル2010で1シートのデータを項目別に別シートへ自動的に分割する方法で困っています。
検索するとマクロを使うと書いていますが、マクロはほとんど使ったことが無いのもあって、わかりませんでした。

シート1
A列(日付8ケタ+商品番号6ケタ) B列(売上額)
20130515000004           300
20130515000006           100
20130518000004           300
20130519000001           500
20130519000004           300
・・・           ...続きを読む

Aベストアンサー

手順:
元データのブックを一度保存して開き直す
ALT+F11を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

sub macro1()
 dim myPath as string
 dim myFile as string
 dim h as range
 dim s as string
 dim w as worksheet

 mypath = thisworkbook.path & "\"
 on error resume next
 kill mypath & "*.csv"
 application.displayalerts = false
 for each w in worksheets
  if w.name <> activesheet.name then w.delete
 next
 application.displayalerts = true
 on error goto errhandle

 for each h in range("A1:A" & range("A65536").end(xlup).row)
 if isnumeric(h.value) then
  s = left(h.value, 8)

 ’CSVに書き出し
  open mypath & "uriage" & s & ".csv" for append as #1
  print #1, h.value & "," & h.offset(0,1).value
  close #1

 ’シートに書き出し
  h.entirerow.copy worksheets(s).range("A65536").end(xlup).offset(1)

 end if
 next

 for each w in worksheets
  w.columns("A:B").autofit
 next
 exit sub

errhandle:
 worksheets.add after:=worksheets(worksheets.count)
 activesheet.name = s
 range("A1:B1") = array("date", "value")
 resume
end sub


ファイルメニューから終了してエクセルに戻る
ALT+F8を押しマクロを実行すると,CSVを書き出す。



#「CSVを書き出す」のが目的で「別シートに振り分ける」こと自体に目的はないと思いましたが,まぁご相談なのでシートに書き出しも追加しました。。。と思って書き足してったら無駄に長いマクロになっちゃいました。あんまりイミなかったです。

手順:
元データのブックを一度保存して開き直す
ALT+F11を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

sub macro1()
 dim myPath as string
 dim myFile as string
 dim h as range
 dim s as string
 dim w as worksheet

 mypath = thisworkbook.path & "\"
 on error resume next
 kill mypath & "*.csv"
 application.displayalerts = false
 for each w in worksheets
  if w.name <> activesheet.name then w.delete
 next
 a...続きを読む


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング