advanced help
per page, with , order by , clip by
Results of 1 - 1 of about 2420 for ピボットテーブル (0.004 sec.)
[[20210726221135]]
#score: 4770
@digest: 61280f3368ee87ece19cd5a48f2891e5
@id: 88468
@mdate: 2021-07-29T08:30:30Z
@size: 18551
@type: text/plain
#keywords: 訳) (39789), 複度 (37491), 香典 (35753), pvtable (30637), 後任 (28852), 計. (28320), 内訳 (24762), 目). (24099), 支出 (18935), 収入 (17002), 馴染 (12278), 入") (11456), 度数 (11084), トテ (9335), ピボ (8972), item (7077), pivotfields (6380), dictionary (5773), テー (5438), ーブ (5397), ・ω (5212), ・` (5022), ボッ (4763), ブル (4050), 小計 (4050), 集計 (3956), ワン (3846), 項目 (3538), ット (2911), scripting (2882), ィー (2707), ルエ (2695)
『集計表について』(tt21)
下記のA:Gの表からQ:Uのような集計表をワンクリックで作成するにあたり、解法のアドバイスをお願いします。 (説明) ・同じ項目は収入、支出を集計する ・同じ項目に複数の内訳がある場合は、複数の内訳の集計を(小計)として最上位に出力し、その下に内訳の集計を出力する ・度数は項目あるいは内訳の重複回数を意味します(チェック用です) ・異なる項目内に同じ内訳が存在します(香典の例) C/R A B C D E F G - Q R S T U 1 - - - - - - - - - - - - - 2 No. 日付 項目 内訳 詳細 収入 支出 - 項目 内訳 収入 支出 度数 3 - - 繰越金 前期 - 0 0 - 繰越金 前期 0 0 1 4 - - 会費 新入会員 - 45000 0 - 会費 新入会員 45000 0 1 5 - - 活動費 役員会 - 0 5092 - 活動費 (小計) 18000 82135 3 6 - - 活動費 送迎会 - 0 77043 - 役員会 0 5092 1 7 - - 補助金 △△会 - 0 3000 - 送迎会 18000 77043 2 8 - - 慶弔費 ○○神社 - 0 15000 - 補助金 (小計) 5000 3000 2 9 - - 活動費 送迎会 - 18000 0 - △△会 0 3000 1 10 - - 慶弔費 香典 - 0 5000 - 香典 5000 0 1 11 - - 慶弔費 香典 - 0 5000 - 慶弔費 (小計) 0 25000 3 12 - - 補助金 香典 - 5000 0 - ○○神社 0 15000 1 13 - - - - - - - - 香典 0 10000 2 (お願い) 一応、Dictionaryを2つ使って解決はしておりますが、いかにも“遠回り”のような気がしております。 できればキーは一つにしてもっと効率よくできないかと思っています。 (特に出力のところ…キーの分割とか効率悪いと思っています) “こういうふうに考えたらどうか”というヒントをもらえないでしょうか? ピボットテーブルも検討しましたが、ワンクリックでできるメドが立たなかったのと知識不足で 現時点では考慮外としています。 (私の検討結果) 実コードは他の処理もありダラダラと長いので、関連のみ書き換えて示します。 Sub test() Dim sh As Worksheet '対象シート Dim sr As Long '開始行(入力式) Dim er As Long '最終行(自動取得) Set sh = ActiveSheet '明細シート xxxxx sr=3:er=99 With sh '/ 集計;キーを二つ持つ Dim dic_1 As Object, dic_2 As Object 'dic_1;項目, dic_2;項目|内訳 Dim ky1, ky2 '各Key Dim yi As Long, yo As Long '収入,支出 Dim ct1 As Long, ct2 As Long '重複度数 Dim r As Long '行カウンタ Set dic_1 = CreateObject("Scripting.Dictionary") Set dic_2 = CreateObject("Scripting.Dictionary") For r = sr To er ky1 = .Cells(r, "C").Value ky2 = .Cells(r, "C").Value & "|" & .Cells(r, "D").Value yi = .Cells(r, "F").Value yo = .Cells(r, "G").Value '..項目を登録 If Not dic_1.exists(ky1) Then dic_1.Add ky1, Array(yi, yo, 1) Else yi = dic_1(ky1)(0) + .Cells(r, "F").Value yo = dic_1(ky1)(1) + .Cells(r, "G").Value ct1 = dic_1(ky1)(2) + 1 dic_1(ky1) = Array(yi, yo, ct1) End If '..項目|内訳を登録 yi = .Cells(r, "F").Value yo = .Cells(r, "G").Value If Not dic_2.exists(ky2) Then dic_2.Add ky2, Array(yi, yo, 1) Else yi = dic_2(ky2)(0) + .Cells(r, "F").Value yo = dic_2(ky2)(1) + .Cells(r, "G").Value ct2 = dic_2(ky2)(2) + 1 dic_2(ky2) = Array(yi, yo, ct2) End If '/ 出力;重複度数に応じて出力していく Dim buf As Variant Dim k As Long, e As Long, rp As Long Dim ct As Long '重複度数 Dim co As String '内訳 '..格納(Dic_2) Dim ary_1, ary_2 ary_1 = dic_2.keys ary_2 = dic_2.items k = sr For Each buf In dic_1 ct = dic_1.Item(buf)(2) rp = 1 'ループ回数 For e = 0 To UBound(ary_2) Dim sp sp = Split(ary_1(e), "|") 'Dic_2キーを分割 If buf = sp(0) Then 'Dic_1キーとDic_2キーの項目を比較 If ct = 1 Then '重複=1 .Cells(k, "Q").Value = buf '項目 .Cells(k, "R").Value = sp(1) '内訳(Dic_2) .Cells(k, "S").Resize(1, 3).Value = ary_2(e) '収入/支出/重複度数(Dic_2) Exit For Else If rp = 1 Then .Cells(k, "Q").Value = buf .Cells(k, "R").Value = "(小計)" .Cells(k, "S").Resize(1, 3).Value = dic_1.Item(buf) rp = rp + 1 End If k = k + 1 .Cells(k, "R").Value = sp(1) '内訳(Dic_2) .Cells(k, "S").Resize(1, 3).Value = ary_2(e) '収入/支出/重複度数(Dic_2) End If End If Next e k = k + 1 Next buf End With End Sub 確認は明日以降でレス遅くなるかと思いますが、よろしくお願いします。 ※質問での表の書き方がよくわからず見苦しくてすみません 本題から外れますが、方法教えていただけると助かります < 使用 Excel:Excel2010、使用 OS:Windows10 > ---- [[20110209184943]] とても、重宝しています。。。 余計なお世話かもしれませんが エラーで実行出来ませんでしたですよ。 コンパイルエラー EndWithに対応するwithがありません。^^; 整理のお手伝いだけで済みません。 m(_ _)m (隠居じーさん) 2021/07/26(月) 23:37 ---- (隠居じーさん)さん 早々にありがとうございます。 ご紹介サイト、じっくり見てみます。 エラーはおそらく転載ミスかと思いますが、 明日確認します… (tt21) 2021/07/27(火) 00:08 ---- 試しにやってみたら結構面倒でした。 やっぱりピボットテーブルがおススメですね Sub sample() Dim 集計 As Dictionary, aRow As Range Dim 項目 As String, 内訳 As String, 収入 As Long, 支出 As Long Set 集計 = CreateObject("Scripting.Dictionary") For Each aRow In Range("C3", Cells(Rows.Count, "C").End(xlUp)).Resize(, 5).Rows 項目 = aRow.Cells(1, 1) 内訳 = aRow.Cells(1, 2) 収入 = aRow.Cells(1, 4) 支出 = aRow.Cells(1, 5) If Not 集計.Exists(項目) Then 集計.Add 項目, CreateObject("Scripting.Dictionary") End If With 集計.Item(項目) If Not .Exists(内訳) Then .Add 内訳, CreateObject("Scripting.Dictionary") With .Item(内訳) .Add "収入", CreateObject("Scripting.Dictionary") .Add "支出", CreateObject("Scripting.Dictionary") End With End If End With With 集計.Item(項目).Item(内訳) If 収入 > 0 Then With .Item("収入") .Add .Count + 1, 収入 End With End If If 支出 > 0 Then With .Item("支出") .Add .Count + 1, 支出 End With End If End With Next i = 3 For Each buf1 In 集計.Keys Cells(i, "I") = buf1 Cells(i, "J") = "小計" j = 1 For Each buf2 In 集計.Item(buf1) Cells(i + j, "J") = buf2 With 集計.Item(buf1).Item(buf2) S = 0 For Each buf3 In 集計.Item(buf1).Item(buf2).Item("収入").Items S = S + buf3 Next Cells(i + j, "K").Value = S S = 0 For Each buf3 In 集計.Item(buf1).Item(buf2).Item("支出").Items S = S + buf3 Next Cells(i + j, "L").Value = S Cells(i + j, "M").Value = .Item("収入").Count + .Item("支出").Count End With j = j + 1 Next Cells(i, "K").Resize(, 3).FormulaR1C1 = "=SUBTOTAL(9,R[1]C:R[" & j - 1 & "]C)" i = i + j Next End Sub (´・ω・`) 2021/07/27(火) 00:48 ---- >ピボットテーブルも検討しましたが、ワンクリックでできるメドが立たなかったのと知識不足で >現時点では考慮外としています。 少しレイアウトが違いますが、問題はそこですか。 こだわりがなければ、マクロ不要なのですが… (マナ) 2021/07/27(火) 07:45 ---- アウトライン形式が一番近いレイアウトみたいです。 (マナ) 2021/07/27(火) 07:49 ---- (隠居じーさん)さん やはり転載の時に誤っておりました。 ・For r〜のNext rを誤消去してしまいました ・A:G表の最終行の「-」は余計でした ・er=99はer=12とすべきでした お許しください… (´・ω・`)さん ユーザー定義型に関するコンパイルエラーが出ましたので、結果は確認できてません。 上記を含めコード理解にお時間ください… マナさん 本件は、実用化後には後任に引継いでいきたいと考えています。(未来永劫?) A:Gの表は都度更新して入力していきますが、定期的に集計を出す必要があります。 その作業をワンクリック(ワンプッシュ)でしたいです。 (私もこの4月からの引継ぎですが、都度集計を出すのが煩わしくて…) おそらくこれからの後任者は私同様にピボットテーブルに馴染みがないかと思います。 私が勝手にピボットテーブルを難儀に感じているのかも知れませんので、 「簡単に」できるのであれば、拘らないようにはします。 (tt21) 2021/07/27(火) 09:41 ---- 老婆心ながら。 >本件は、実用化後には後任に引継いでいきたいと考えています。(未来永劫?) >おそらくこれからの後任者は私同様にピボットテーブルに馴染みがないかと思います。 ↑について、後任の方がVBAを扱える保障もないのでは。 もし仮にVBAを理解しコーディングできる人だとしても… MSの仕様変更や、予期せぬエラーでマクロが動かなくなったときに 後任の方が他人のソースを読み解き動作確認する手間と ピボットテーブルを理解する手間を天秤にかけたら 間違いなくピボットテーブルの理解のほうが早いと思います。 なんせ、ピボットテーブルの使い方はネットに山ほどあります。 仮にピボットテーブル自体の仕様変更があっても、重要・便利な機能のため すぐに解説記事があがることでしょう。 食わず嫌いせず、一度学んでみてはいかがでしょうか? (山姥) 2021/07/27(火) 09:49 ---- >ユーザー定義型に関するコンパイルエラーが出ました 方針をピボットテーブルでやる方向にするなら、私のコード見なくていいです。 一応動かして見るなら、変数の定義部を Dim 集計 As Object, aRow As Range に変えてください。 ​もとのままだと参照設定が必要なので。 オススメはピボットテーブルです。 Excelの標準機能でできることを、わざわざVBAで組むのは時間の無駄です (趣味や勉強ならOKですが業務でしょ) >おそらくこれからの後任者は私同様にピボットテーブルに馴染みがないかと思います。 イチから初める人が、VBAに馴染むかピボットテーブルに馴染むかを選ぶなら、 ピボットテーブルを選ぶようにしてあげてください。 (´・ω・`) 2021/07/27(火) 10:02 ---- 確認遅くなりすみません… (´・ω・`)さん コード試行の結果は全ての項目に小計欄を出力する点などで私のとは異なりますが、それ自体は一旦おいといて… 「集計.Add 項目, CreateObject("Scripting.Dictionary")」とか「集計.Item(項目).Item(内訳)」などの書き方が?です。 調べてみます… 山姥さん お二人のVBAでやることに対するご意見、ごもっともかと思います。 もとより後任者に無理に引継がせるつもりはなく、先ずは私自身が“楽をしたい”動機があり“使いたければどうぞ”という程度のものです。 相手も含めてブラックボックスでも一向に構わない、という前提です。 そういうのが意に沿わない人はこつこつと手作業でするでしょうし、本件は最終報告書に至る中間生成物のようなものなので、結果が正しければ問題ないと考えています。 (私は“楽をしたい”感が強くありVBAに手を出しましたが、私の周りではおそらくマイナーかと思います) ピボットテーブルでは提示しましたアウトプット(Q:U表)の様式にできるイメージが今は湧きませんが、いい機会なので検討してみたいと思います。 (マナさんのいわれるアウトライン形式?がキーでしょうか?) (tt21) 2021/07/27(火) 23:26 ---- (1)データ範囲を選択 (2)[挿入]タブ→[テーブル]グループ→[ピボットテーブル] (3)ダイアログがでてきたら、ピボットテーブルの配置場所を指定して [OK] (4)空のピボットテーブルができて、右側にピボットテーブルフィールドの設定のウインドウでます。 上のフィールドを、下のボックスにドラッグして集計方法を設定します。 (5)[行]のボックスに [項目]フィールド , [内訳]フィールド を ポイポイとドラッグドロップ (6)[シグマ値]のボックスに[収入]フィールド,[支出]フィールド、[内訳]フィールドをポイポイポイ (7)メニューの[ピボットテーブルツール]→[デザイン]タブ→[レイアウト]グループ→[レポートのレイアウト]→[アウトライン形式で表示] まずここまでやって、気に入らなければ、それからということで。 (´・ω・`) 2021/07/28(水) 11:03 ---- ありがとうございます。 ピボットテーブルについてはじっくり学習するつもりですが、その前に以下について解説あるいは 参考になるサイトをご紹介願えないでしょうか? ・「集計.Add 項目, CreateObject("Scripting.Dictionary")」のようにDictionaryの要素にCreateObjectを記述すること ・「集計.Item(項目).Item(内訳)」のようにItemを連結した書き方 一応調べてみましたが未だに理解できないため、よろしくお願いします… (貧弱なオツムと業務ではないので隙間時間でやっているため、時間かかってすみません) (tt21) 2021/07/28(水) 11:13 ---- そこ、こだわります? DictionaryのアイテムにDictionaryを入れてるだけですが、 その解読やめてピボットテーブル試してって何回書けばいいんですかね (´・ω・`) 2021/07/28(水) 11:24 ---- 横から失礼します。 私もピボットテーブルの使用を推奨します。 個人のタスクであれば何を使っても問題ないものと思いますが、 業務でしかも引き継ぎを念頭に置かれているのであれば、 説明があっても、あなた自身が理解に苦しむようであれば、 候補にできないのではないですか? ちなみに、 DictionaryのアイテムにDictionaryを入れる手法は結構出てきます。 "dictionary 入れ子 VBA"などとして、ここの学校や広くネット検索すれば でてきます。 集計.Item(項目).Item(内訳)は、 集計.Item(項目)で項目に対応するitemであるdictionaryが返り、 さらに .Item(内訳)とすることで、 key内訳に対応するitemが取得できるということです。 (γ) 2021/07/28(水) 12:17 ---- Sub sample() Const pvtName As String = "集計表" Dim pvCache As PivotCache, pvTable As PivotTable 'Dim pvtAlreadyExixt As Boolean Dim pvtAlreadyExist As Boolean ' 7/29 修正 On Error Resume Next Set pvTable = ActiveSheet.PivotTables(pvtName) pvtAlreadyExist = Err = 0 On Error GoTo 0 If pvtAlreadyExist Then With pvTable .PivotCache.SourceData = Range("C2", Cells(Rows.Count, "C").End(xlUp)).Resize(, 5).Address .PivotCache.Refresh .ClearTable End With Else Set pvCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _ SourceData:=Range("C2", Cells(Rows.Count, "C").End(xlUp)).Resize(, 5)) ' 7/29 修正 'Version:=xlPivotTableVersion15) ' 7/29 修正 Set pvTable = pvCache.CreatePivotTable(TableDestination:=Range("I2"), _ TableName:=pvtName) ' 7/29 修正 'DefaultVersion:=xlPivotTableVersion15) ' 7/29 修正 End If With pvTable .HasAutoFormat = False ' 7/29 追加 .RowAxisLayout xlOutlineRow .AddDataField .PivotFields("収入"), "収入計", xlSum .AddDataField .PivotFields("支出"), "支出計 ", xlSum .AddDataField .PivotFields("内訳"), "度数", xlCount With .PivotFields("項目") .Orientation = xlRowField .Position = 1 End With With .PivotFields("内訳") .Orientation = xlRowField .Position = 2 End With End With End Sub (´・ω・`) 2021/07/28(水) 17:17 ---- γさん、助っ人ありがとうございます。 書かれたとおりに検索しているうちに2番目の疑問点であるItem.Itemと記述してあるコードも散見し、 その説明に「行単位の情報をDictionary化したオブジェクトにすることで、そのオブジェクトを…データとして格納することができる」という記述があり、納得できました。 ご懸念については先の方々に対するのと同様に承っておきます。 (因みに、本件は業務ではありませんが、理解できないコードをそのまま使用するつもりはありません) (´・ω・`)さん わからないことをスルーできずに度々の質問失礼しました。 とりあえず先の質問については自分なりの納得を得ましたので、了とさせていただきます。 先に提示いただいたコード、随所に初見の記述がありとても勉強になりました。 再掲いただいたコードはおそらくピボットテープルをVBA化するものと推察しましたが、コンパイルエラーが出て 結果確認には至っておりません。 (下記の思いと時間の都合もあり原因追及はしておりません) 標準機能のピボットテーブルをこなせていないうちはVBAに手を出すのは無謀と思っていますので、 参考程度に記憶しておきたいと思います。 いろいろと煩わせてすみませんでした。 これからもよろしくお願いします… (ピボットテーブル学習中に出た疑問点は、別途投稿させていただくつもりです) (tt21) 2021/07/28(水) 22:29 ---- >ンパイルエラーが出て どこで? (´・ω・`) 2021/07/28(水) 22:56 ---- 質問者さんは、エラー箇所がわかっているのだから これくらいは自分で修正できるようにならないと。 >Dim pvtAlreadyExixt As Boolean ↓ Dim pvtAlreadyExist As Boolean (マナ) 2021/07/28(水) 23:12 ---- マナさん ご指摘ありがとうございます 人にエラソーなこと言えないようなミスでした (´・ω・`) 2021/07/28(水) 23:28 ---- そこは修正済みです。 確かxlPibotTableVersion15がある行でした (明日調べるつもりで…今移動中のためお許しください) (tt21) 2021/07/28(水) 23:50 ---- >xlPibotTableVersion15 そのパラメータは、削除してください。 バージョン指定しなくても大丈夫です。 (マナ) 2021/07/28(水) 23:58 ---- 毎度すみません。 こっそり直しました。 (´・ω・`) 2021/07/29(木) 07:02 ---- ありがとうございます、 集計表出力されました。 手動での表の体裁変更や並べ替えはできるようになりましたが、希望のレイアウト(※)への変更には至っていません。 ※内訳が単一の時は小計欄は不要(質問のQ:U表です) これまで調べた限りではムリっぽいようですが、あまり拘るつもりはありません。 後の課題は項目の並べ替えを自動にすることですが、それはこちらで対応できそうです。 今回、Dictionaryの知識が増えた上にピボットテーブルに触れることができて本当によかったです。 まだ学習途上ですが、これからもよろしくお願いします… (tt21) 2021/07/29(木) 17:30 ...
http://www.excel.studio-kazu.jp/wiki/kazuwiki/202107/20210726221135.txt - [detail] - similar
PREV NEXT
Powered by Hyper Estraier 1.4.13, with 97004 documents and 608067 words.

訪問者:カウンタValid HTML 4.01 Transitional