Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


7632 / 13644 ツリー ←次へ | 前へ→

【37828】集計について ねこ 06/5/19(金) 17:28 質問[未読]
【37835】Re:集計について AMEYakyu 06/5/19(金) 21:28 発言[未読]
【37838】Re:集計について ponpon 06/5/20(土) 2:04 発言[未読]
【37858】Re:集計について Hirofumi 06/5/21(日) 8:01 発言[未読]

【37828】集計について
質問  ねこ  - 06/5/19(金) 17:28 -

引用なし
パスワード
   「作業用」というシートに下記のようなデータが入っています。

A列 B列  C列   D列   E列    F列    G列  H列  I列
No. 大分類 小分類 入場日 入場時間 退場日 退場時間 売上 曜日
1  4   1  2006/05/18 08:30 2006/05/18 12:30 \2000 5
2  4   1  2006/05/18 15:05 2006/05/19 05:50 \4500 5
3  4   2  2006/05/18 14:45 2006/05/18 18:05 \2400 5
4  5   3  2006/05/18 20:30 2006/05/18 23:15 \1500 5
5  4   3  2006/05/19 03:10 2006/05/19 04:00 \200  6

これを利用して別シート(作業用(一覧))に集計したいです。
集計したい項目は「大分類別売上」、「大分類&小分類別売上」、「大分類別のデータのカウント」、「大分類&小分類別のデータのカウント」、「曜日別売上」です。
すでに項目ごとに作業用(一覧)シートには下記のような簡単な表を作成してありますので、取得した値を入れたいと思っています。

A列 B列
1  \○○←ここにデータを入れたいです。
2  \○○
3  \○○

フォーマットは全て同じです。

ちなみに曜日は入場日を基準にシリアル値で取得しています。
またマクロは同じ階層の別ブックに保存したいと思っています。
(他のマクロが大量にあるので、マクロブックとデータ表示ブックは分けています。)

そんなに複雑ではないと思うのですが、初心者なのでわかりません。
是非いいアドバイスをお願いします。

【37835】Re:集計について
発言  AMEYakyu  - 06/5/19(金) 21:28 -

引用なし
パスワード
   ▼ねこ さん:

今晩は。
多くの内容を有したものですね。
このような内容で有れば、むしろ単純にシート関数で仕上げた方が楽ではないでしょうか?
マクロで作成することは出来ますが、エクセルのシートでお互いがやり取りするので有れば、進め易いでしょうが、この面でやり取りするのはお互いにかなりのエネルギーが要るのでは?
大分類別売上も、何種類の分類があるのか・・・も一つずつ聞いていかなければならないし、「大分類&小分類別売上」といわれてもどのような意味か分からないし「:::データのカウント」?は何のことなんでしょう・・・なんて聞かなくてはならないことが多すぎはしません?
もう少しシンプルに質問されては如何でしょうか・・・
先ず自分で、シート関数で仕上げられては如何でしょう?

回答になっていませんが、感想です。

【37838】Re:集計について
発言  ponpon  - 06/5/20(土) 2:04 -

引用なし
パスワード
   Dictionaryの練習用に一応作ってみました。
もっといい方法があると思います。
書き出しが何かどんくさいです。
出力の形式がいまいち分からなかったので
勝手にこっちでやってます。
参考にしてください。

Sub test()
  Dim myDic1 As Object
  Dim myDic2 As Object
  Dim myDic3 As Object
  Dim myKeys1, myKeys2, myKeys3
  Dim myItems1, myItems2, myItems3
  
  Dim myR As Range
  Dim r As Range
  Dim I As Long
  With Sheets("作業用")
    Set myDic1 = CreateObject("Scripting.Dictionary")
    Set myDic2 = CreateObject("Scripting.Dictionary")
    Set myDic3 = CreateObject("Scripting.Dictionary")
    Set myR = .Range("B2", .Range("B65536").End(xlUp))
    
    For Each r In myR
     myDic1(r.Value) = myDic1(r.Value) + r.Offset(, 6).Value
     myDic2(CStr(r.Value) & "&" & CStr(r.Offset(, 1).Value)) = myDic2(CStr(r.Value) & "&" & CStr(r.Offset(, 1).Value)) + r.Offset(, 6).Value
     myDic3(r.Offset(, 7).Value) = myDic3(r.Offset(, 7).Value) + r.Offset(, 6).Value
    Next
  End With
  With Sheets("作業用(一覧)")
    .Cells.ClearContents
    .Range("A1").Value = "大分類別売上": .Range("D1").Value = "大分類&小分類別売上": .Range("G1").Value = "曜日別売上"
    myKeys1 = myDic1.keys
    myItems1 = myDic1.items
    For I = 0 To myDic1.Count - 1
     .Cells(I + 2, 1).Value = myKeys1(I)
     .Cells(I + 2, 2).Value = myItems1(I)
    Next
    .Range("A65536").End(xlUp).Offset(1).Value = "件数"
    .Range("A65536").End(xlUp).Offset(, 1).Value = myDic1.Count
    
    myKeys2 = myDic2.keys
    myItems2 = myDic2.items
    For I = 0 To myDic2.Count - 1
     .Cells(I + 2, 4).Value = myKeys2(I)
     .Cells(I + 2, 5).Value = myItems2(I)
    Next
    .Range("D65536").End(xlUp).Offset(1).Value = "件数"
    .Range("D65536").End(xlUp).Offset(, 1).Value = myDic2.Count
    
    myKeys3 = myDic3.keys
    myItems3 = myDic3.items
    For I = 0 To myDic3.Count - 1
     .Cells(I + 2, 7).Value = myKeys3(I)
     .Cells(I + 2, 8).Value = myItems3(I)
    Next

  End With
  
End Sub

【37858】Re:集計について
発言  Hirofumi  - 06/5/21(日) 8:01 -

引用なし
パスワード
   Excel本来の機能で出来るのだろうけど?
出力は、出力レイアウトが解らないので適当です

Option Explicit

Public Sub Sample()

  '項目Aのデータ列数(A列〜I列)
  Const clngColumns As Long = 9
  '整列Key1列位置(B列、A列からの列Offset)
  Const clngKeys1 As Long = 1
  '整列Key2列位置(C列、A列からの列Offset)
  Const clngKeys2 As Long = 2
  
  Dim i As Long
  Dim rngList As Range
  Dim lngRows As Long
  Dim vntList As Variant
  Dim rngResult As Range
  Dim lngWrite As Long
  Dim vntTotal As Variant
  Dim vntSubTotal As Variant
  Dim vntWeekday As Variant
  Dim strProm As String

  'データのA1を基準とします(列見出しの「No.」セル位置)
  Set rngList = ActiveWorkbook.Worksheets("作業用").Cells(1, "A")
  
  With rngList.Parent.Parent
    '「作業用(一覧)」出力のA1を基準とする
    Set rngResult = .Worksheets("作業用(一覧)").Cells(1, "A")
  End With
  
  '画面更新を停止
  Application.ScreenUpdating = False
  
  '基準に就いて
  With rngList
    '行数を取得
    lngRows = .Offset(65536 - .Row, _
            clngKeys1 - 1).End(xlUp).Row - .Row
    If lngRows < 0 Then
      strProm = rngList.Parent.Name & "にデータが有りません"
      GoTo Wayout
    End If
    'データをclngKeys1列で整列
    .Offset(1).Resize(lngRows, clngColumns).Sort _
      Key1:=.Offset(1, clngKeys1), Order1:=xlAscending, _
      Key2:=.Offset(1, clngKeys2), Order2:=xlAscending, _
      Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
      Orientation:=xlTopToBottom, SortMethod:=xlStroke
    'データを配列に取得
    vntList = .Offset(1, 1).Resize(lngRows + 1, clngColumns - 2).Value
    '元データを復帰
    .Offset(1).Resize(lngRows, clngColumns).Sort _
      Key1:=.Offset(1), Order1:=xlAscending, _
      Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
      Orientation:=xlTopToBottom, SortMethod:=xlStroke
  End With
  
  '「曜日別売上」の出力用配列を確保
  ReDim vntWeekday(1 To 7, 1 To 3)
  For i = 1 To 7
    vntWeekday(i, 1) = Choose(i, "日曜", "月曜", "火曜", "水曜", "木曜", "金曜", "土曜")
  Next i
  '「大分類別売上」の出力用配列を確保
  ReDim vntTotal(1 To 1, 1 To 4)
  '「大分類&小分類別売上」の出力用配列を確保
  ReDim vntSubTotal(1 To 1, 1 To 4)
  
  '列見出しを出力
  rngResult.Offset(lngWrite).Resize(, 4).Value = Array("大分類", "小分類", "売上", "カウント")
  
  '集計初期値設定
  vntTotal(1, 2) = vntList(1, 1)
  AddUp vntSubTotal, vntList, 1
  vntWeekday(WeekDay(vntList(1, 3)), 2) = vntList(1, 7)
  '集計出力
  For i = 2 To lngRows + 1
    '大分類が違ったら
    If vntTotal(1, 2) <> vntList(i, 1) Then
      '集計小分類の出力
      OutputSubTotal vntTotal, vntSubTotal, rngResult, lngWrite
      '「大分類別売上」の出力位置を更新
      lngWrite = lngWrite + 1
      '「大分類別売上」へ出力
      vntTotal(1, 2) = "合計"
      rngResult.Offset(lngWrite).Resize(, _
          UBound(vntTotal, 2)).Value = vntTotal
      '「大分類別売上」の出力用配列を確保
      ReDim vntTotal(1 To 1, 1 To 4)
      '集計初期値を代入
      vntTotal(1, 2) = vntList(i, 1)
    Else
      '小分類が違ったら
      If vntSubTotal(1, 2) <> vntList(i, 2) Then
        '集計小分類の出力
        OutputSubTotal vntTotal, vntSubTotal, rngResult, lngWrite
      End If
    End If
    '小分類を集計
    AddUp vntSubTotal, vntList, i
    '「曜日別売上」を集計
    vntWeekday(WeekDay(vntList(i, 3)), 2) _
        = vntWeekday(WeekDay(vntList(i, 3)), 2) + vntList(1, 7)
    vntWeekday(WeekDay(vntList(i, 3)), 3) _
        = vntWeekday(WeekDay(vntList(i, 3)), 3) + 1
  Next i
  
  With rngResult
    '列見出しを出力
    .Offset(, 5).Resize(, 3).Value = Array("曜日別売上", "売上", "カウント")
    '「曜日別売上」を出力
    .Offset(1, 5).Resize(UBound(vntWeekday, 1), _
            UBound(vntWeekday, 2)).Value = vntWeekday
  End With
  
  strProm = "処理が完了しました"
  
Wayout:
  
  '画面更新を再開
  Application.ScreenUpdating = True
  
  Set rngList = Nothing
  Set rngResult = Nothing
  
  MsgBox strProm, vbInformation
  
End Sub

Private Sub AddUp(vntSum As Variant, vntList As Variant, lngPos As Long)

  '大分類を代入
  vntSum(1, 1) = vntList(lngPos, 1)
  '小分類を代入
  vntSum(1, 2) = vntList(lngPos, 2)
  '売上を加算
  vntSum(1, 3) = vntSum(1, 3) + vntList(lngPos, 7)
  'カウントを加算
  vntSum(1, 4) = vntSum(1, 4) + 1

End Sub

Private Sub OutputSubTotal(vntTotal As Variant, _
              vntSubTotal As Variant, _
              rngResult As Range, _
              lngWrite As Long)

  '大分類別売上集計用配列に小分類の売上、カウントを加算
  vntTotal(1, 3) = vntTotal(1, 3) + vntSubTotal(1, 3)
  vntTotal(1, 4) = vntTotal(1, 4) + vntSubTotal(1, 4)
  '「大分類&小分類別売上」の出力位置を更新
  lngWrite = lngWrite + 1
  '「大分類&小分類別売上」へ出力
  rngResult.Offset(lngWrite).Resize(, _
      UBound(vntSubTotal, 2)).Value = vntSubTotal
  '「大分類&小分類別売上」の出力用配列を確保
  ReDim vntSubTotal(1 To 1, 1 To 4)

End Sub

7632 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free