Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Home : Excel 2016)
小計を計算する方法で教えてください
投稿日時: 21/09/01 16:02:43
投稿者: yurappy

お世話になります。
 
集計の手順で作業方法がわからないので教えてください。
 
毎日、下記のように1シートに1日分の明細を入力しております。
 
 
 
 
毎日入力している今日の明細
 
お名前(B列)  返却日(C列)  住所1(D列)  住所2(E列)  料金(F列)
 
氏名A      7月6日      住所A      住所A      300
氏名A      7月5日      住所A      住所A      200
氏名B      7月7日      住所B      住所B      300
氏名A      7月5日      住所A      住所A      300
氏名B      7月5日      住所B      住所B      200
氏名A      7月10日      住所A      住所A      300
氏名C      7月6日      住所C      住所C      300
氏名A      7月5日      住所A      住所A      100
氏名C      7月6日      住所C      住所C      400
 
    以下略
 
 
こちらが、集計をしてまとめたい集計結果の表示例です。
 
 
今日の集計
 
氏名A  住所A  住所B  1200
氏名B  住所B  住所B  500
氏名C  住所C  住所B  700
 
 
 
 
 
毎日、C列を削除してからお名前毎に手計算で集計をしておいて、B列をエクセルの重複削除の機能で重複を削除して、手計算で集計しておいた値を手入力してます。
 
エクセルの小計の機能で集計をすると、住所が消えてしまって利用できず、お名前と料金の合計だけになってしまい、諦めて手で計算(小計の集計)をするなど手作業で行ってます。
 
どの様な手順や式で集計をするのかわからず、集計ができなくて困ってます。
 
グループ化して集計をする方法とか、小計の仕方のVBAをネットで調べても、どうすれば良いのかわからず悩んでおります。
 
 
 
希望としては、
 
1 C列を削除する [ Columns("C").Delete ]
 
2 お名前をキーに料金を自動で集計する
 
3 重複していたデータは削除する
 
4 お名前 住所1 住所2 料金の合計 の様に並べて表示する
 
5 毎日行う作業なので、マクロで効率化したい
 
の様に動作をして欲しいのです。
 
 
何か良い方法がございましたら教えてください。
 
よろしくお願いいたします。
 
 

回答
投稿日時: 21/09/01 16:47:55
投稿者: Suzu

1. データ範囲 B1:F10 を選択
2. 「データ」タブ 「データの取得と変換」から「テーブルまたは範囲から」
3. 先頭行をテーブルの見出しとして使用する にチェック OK PowerQuery エディターが開く
4. PowerQueryエディター「ホーム」タブ 「グループ化」
5. グループ化する列と、求める出力を指定します。 にて
    「詳細設定」
      下のコンボボックスから、【お名前】を選択
      グループ化の追加 を 行い、【住所1】を選択
      グループ化の追加 を 行い、【住所2】を選択
         詳細設定の下 に、【お名前】【住所1】【住所2】 が並んでいる事になる
 
    「新しい列名」 に、 【料金_小計】とでもして、
    「操作」    を、 合計
    「列」     を、 料金
      として、OK
6. 希望のデータが得られている事を確認し、「ホーム」タブの、「閉じて読み込む」をクリック
 
 
必要なら、マクロの記録をしてみてください。

投稿日時: 21/09/01 17:36:39
投稿者: yurappy

Suzuさま
 
お世話になります。
 
ご親切にありがとうございます。
早速にありがとうございます。
 
試してみまして、思うような形になりましたが、マクロの記録をして次に試すと「***という名前のクエリは既に存在します。」とエラーになってダメでした。
 
エクセルもマクロも初心者で疎くて、先に進めなくなってます。
 
毎回、 Name:="テーブル1"  の様な該当しそうな箇所の名前を毎回手作業で変えて、選択範囲の行番号も同じく変えてあげると動作しました。
 
各シート毎に、教わった操作を手作業ですると動くのです。
行数も、日ごと(シート毎)の違うので、どうするのかとか、名前を変える箇所を毎回マクロで変える方法がわかりません。
 
甘えて申し訳ございませんが、何か対策方法がありましたら教えていただければ助かります。
 
お手数おかけしてすみません。
 
よろしくお願いいたします。

回答
投稿日時: 21/09/01 21:42:07
投稿者: 半平太

この種のものは、Dictionaryオブジェクトで集計すれば簡単ですよ。
 
サンプルを見ると、タイトルとデータの間に1行空いているように見えますが、
実際は詰まっているんですか? それともホントに空いているんですか?
 
それによってコードが少し変わるのでお聞きします。

投稿日時: 21/09/02 07:42:49
投稿者: yurappy

半平太さま
 
おはようございます。
お世話になります。
 
紛らわしい書き方で、申し訳ございません。
 

引用:
サンプルを見ると、タイトルとデータの間に1行空いているように見えますが、

 
タイトルとデータの間に行(隙間)は無く、1行目タイトル 、 2行目から値  の様になってます。
 
 
Dictionaryオブジェクト をネットで調べたのですが、どこに書くのかからわからず、素人でも大丈夫でしょうか。
 
お手数をおかけして申し訳ございませんが、よろしかったらご教授ください。
 
ご親切にありがとうございます。
 
よろしくお願いいたします。
 

回答
投稿日時: 21/09/02 09:19:18
投稿者: 半平太

こんな風に書く
 

Sub DIGEST()
    Dim dicT As Object
    Dim rToProc As Range '処理すべきデータ範囲
    Dim cel As Range
    Dim Data
    
    Set dicT = CreateObject("Scripting.Dictionary")
    Set rToProc = Intersect(Range("B1").CurrentRegion, Columns("B:F"))
    
    For Each cel In rToProc.Columns(1).Cells '左端列(名前列)のセルの内容を見ていく
        If cel.Value <> "" Then
            Data = dicT(cel.Value) 'celのValueをキーにして、Dictionaryの内容を取り出す
            
            If IsArray(Data) Then '配列型であれば既に存在する名義である
                Data(4) = Data(4) + cel.Offset(, 4).Value  '金額を加算するだけ
            Else '新名義の処理
                ReDim Data(1 To 4)
                Data(1) = cel.Value
                Data(2) = cel.Offset(, 2).Value
                Data(3) = cel.Offset(, 3).Value
                Data(4) = cel.Offset(, 4).Value
            End If
            
            dicT(cel.Value) = Data '累計したデータをDictionaryに再登録する
        End If
    Next cel
    
    '結果を既存の表の下に打ち出し
    rToProc.Offset(rToProc.Rows.Count + 2).Resize(dicT.Count, 4).Value = Application.Index(dicT.items, 0, 0)
    
    dicT.RemoveAll
End Sub

<結果図>
行  _______B_______  _______C_______  ______D______  ______E______  ______F______
 1  お名前(B列)   返却日(C列)   住所1(D列)  住所2(E列)  料金(F列) 
 2  氏名A                   7月6日   住所A          住所A2                300
 3  氏名A                   7月5日   住所A          住所A2                200
      (中間省略)
10  氏名C                   7月6日   住所C          住所C2                400
11                                                                               
12                                                                               
13  お名前(B列)   住所1(D列)    住所2(E列)  料金(F列)        
14  氏名A            住所A            住所A2               1200       
15  氏名B            住所B            住所B2                500       
16  氏名C            住所C            住所C2                700       

投稿日時: 21/09/02 09:54:45
投稿者: yurappy

半平太さま
  
お世話になります。
ご親切にありがとうございます。
 
思っていたような集計ができて、とても嬉しいです。
ビックリしちゃいました。
 
 
1つ、わがままなお願いですが、いただいた式ですと集計を下部に書き出していただいているのですが、下部で反くて元の表に上書きする様な形で 
 
 A1のセルから右に集計後の見出し
 A2のセルから集計した値
 
の様な表示か、下で無くて右にずらして E1 のセルから始まるようなことは可能でしょうか。
 
 

引用:
rToProc.Offset(rToProc.Rows.Count + 2).Resize(dicT.Count, 4).Value = Application.Index(dicT.items, 0, 0)

 
の箇所をいじってみたのですが、位置が変わらずにいてすみません。
 
何度もお手数をおかけして、本当にすみません。
 
よろしくお願いいたします。
 
ごめんなさい。

回答
投稿日時: 21/09/02 10:09:34
投稿者: 半平太

>E1 のセルから始まるようなことは可能でしょうか。
 
元データは(こちらとしては)なるべく消したくないので、
右に打出方式になりますが、E列は元データがあるエリアなので、
もっと右(H列)からにしますよ。
 
へ変更
 ↓
Range("H1").Resize(dicT.Count, 4).Value = Application.Index(dicT.items, 0, 0)

投稿日時: 21/09/02 11:17:17
投稿者: yurappy

半平太さま
  
お世話になります。
ご親切に、ありがとうございます。
 
願っていたようにバッチリ動きました。
ありがとうございます。
 
そして、勉強になりました。
Dictionaryオブジェクトを知らなかったので、とても参考になって応用もできそうで嬉しいです。
 
本当にありがとうございました。
 
また困った時には助けてください。
 
ありがとうございました。
 
嬉しかったです。