Excel VBA質問箱 IV

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

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


11637 / 13646 ツリー ←次へ | 前へ→

【15001】集計表の作成について 美咲 04/6/13(日) 1:42 質問[未読]
【15004】Re:集計表の作成について Hirofumi 04/6/13(日) 9:47 回答[未読]
【15021】Re:集計表の作成について 美咲 04/6/13(日) 16:07 質問[未読]
【15022】Re:集計表の作成について Hirofumi 04/6/13(日) 16:42 回答[未読]
【15026】Re:集計表の作成について Hirofumi 04/6/13(日) 19:51 回答[未読]
【15030】Re:集計表の作成について 美咲 04/6/13(日) 22:37 お礼[未読]

【15001】集計表の作成について
質問  美咲  - 04/6/13(日) 1:42 -

引用なし
パスワード
   こんにちは、VBA初心者です。
金曜の夜から寝ないでVBAをやっているのですが、
うまく集計表が出来ません。
どうか教えて下さいませんか?

このような表を
課名 費目 4月  5月  6月 
1課  ▲   1  4   9
1課  △   3  2  11
2課  ▲   8  6  10
2課  △   7  5   0

こういう風に集計したいのですが

    4月    5月    6月
課名  ▲  △  ▲  △  ▲  △
1課  1  3  4  2   9  11
2課  8  7  6  5  10  0
  
全然うまくいきません。
どうか教えて下さい。。

【15004】Re:集計表の作成について
回答  Hirofumi  - 04/6/13(日) 9:47 -

引用なし
パスワード
   以下の様な形にするだけで善いのですね?

Sheet1 
    A    B    C    D    E
1    課名    費目    4月    5月    6月 
2    1課    ▲    1    4    9
3    1課    △    3    2    11
4    2課    ▲    8    6    10
5    2課    △    7    5    0


Sheet2
    A    B    C    D    E    F    G
1        4月        5月        6月
2    課名    ▲    △    ▲    △    ▲    △
3    1課    1    3    4    2    9    11
4    2課    8    7    6    5    10    0


以下を標準モジュールに記述して下さい

Option Explicit

Public Sub AddUp()

  Dim i As Long
  Dim rngData As Range
  Dim lngRow As Long
  Dim lngCol As Long
  Dim rngResult As Range
  
  '結果表の左上セル位置を設定
  Set rngResult _
    = Worksheets("Sheet2").Cells(1, "A")
  'データ表の左上セル位置を設定
  Set rngData _
    = Worksheets("Sheet1").Cells(1, "A")
  
  'データ表に就いて
  With rngData
    '月列の数を取得
    lngCol = .End(xlToRight).Column _
            - .Offset(, 2).Column
    'データ行数を取得
    lngRow = .Offset(, 1).End(xlDown).Row _
              - .Offset(, 1).Row
  End With
  
  '行見だしを作成
  WriteRowTitle rngData, rngResult, lngRow
  
  '月の列の先頭から最後まで繰り返し
  For i = 0 To lngCol
    '月別に集計
    ListWrite i, rngData, rngResult, lngRow
  Next i
  
  Set rngData = Nothing
  Set rngResult = Nothing

  Beep
  MsgBox "処理が完了しました"
  
End Sub

Private Sub ListWrite(lngRead As Long, _
            rngData As Range, _
            rngResult As Range, _
            lngRow As Long)

  Dim i As Long
  Dim vntData As Variant
  Dim vntResult As Variant
  
  '出力用配列を確保
  ReDim vntResult(0 To lngRow \ 2 + 1, 0 To 1)
  'データ表の左上セルに就いて
  With rngData
    'データを配列に取得
    vntData _
      = .Offset(1, _
        lngRead + 2).Resize(lngRow).Value
    '月名を出力用配列に代入
    vntResult(0, 0) _
        = .Offset(, lngRead + 2).Value
    '▲を出力用配列に代入
    vntResult(1, 0) = .Offset(1, 1).Value
    '△を出力用配列に代入
    vntResult(1, 1) = .Offset(2, 1).Value
  End With
  
  'データを出力用配列に書き込み
  For i = 1 To UBound(vntData)
    vntResult((i - 1) \ 2 + 2, (i - 1) Mod 2) _
                  = vntData(i, 1)
  Next i
  
  '出力用配列を出力
  With rngResult.Offset(, lngRead * 2 + 1)
    .Resize(lngRow \ 2 + 2, 2).Value = vntResult
  End With
  
End Sub

Private Sub WriteRowTitle(rngData As Range, _
            rngResult As Range, _
            lngRow As Long)
  
  Dim i As Long
  Dim vntData As Variant
  Dim vntResult As Variant
  
  '出力用配列を確保
  ReDim vntResult(0 To lngRow \ 2 + 1, 0 To 0)
  'データ表の左上セルに就いて
  With rngData
    'データを配列に取得
    vntData = .Resize(lngRow + 1).Value
  End With
  
  '課名を出力用配列に代入
  vntResult(1, 0) = vntData(1, 1)
  '課を出力用配列に代入
  For i = 2 To UBound(vntData) Step 2
    vntResult(i \ 2 + 1, 0) = vntData(i, 1)
  Next i
  
  '出力用配列を出力
  With rngResult
    .Resize(lngRow \ 2 + 2).Value = vntResult
  End With
  
End Sub

【15021】Re:集計表の作成について
質問  美咲  - 04/6/13(日) 16:07 -

引用なし
パスワード
   hirofumiさん、本当にありがとうございます(涙)
全然上手くいかなくて、途方にくれていました。
また初心者な質問をさせて頂いてもよろしいでしょうか。
Sheet1の情報を、
費目を10個、
課名等の列情報を6個、
行データは費目10個×100課分
月は4月〜03月

プラスし、Sheeet2の集計表にしたい場合
教えて頂いた標準モジュールのどの箇所を修正したら
出来上がるでしょうか。。。

【15022】Re:集計表の作成について
回答  Hirofumi  - 04/6/13(日) 16:42 -

引用なし
パスワード
   そう言う事は先に書く物だよ!
見て見るけれど、作り直しに成るかも?

解らない所が有ります

>課名等の列情報を6個、
とは、どう言う意味ですか?
課名、費目、4月、・・と有るけど
何処の列に入るの?(並び順?)、また課名、費目の列は何列?
4月、・・列は何列?
行は、課名順の、費目順に成っているの?

【15026】Re:集計表の作成について
回答  Hirofumi  - 04/6/13(日) 19:51 -

引用なし
パスワード
   Sheet1

   A  B  C  D  E  F  G   H   I   J
 1 課名 項1 項2 項3 項4 項5 費目  4月  5月  6月
 2 1課  A  B  C  D  E  ▲   1  11  21
 3 1課  A  B  C  D  E  △   2  12  22
 4 1課  A  B  C  D  E  ●   3  13  23
 5 1課  A  B  C  D  E  ○   4  14  24
 6 1課  A  B  C  D  E  ■   5  15  25
 7 1課  A  B  C  D  E  □   6  16  26
 8 1課  A  B  C  D  E  ◆   7  17  27
 9 1課  A  B  C  D  E  ◇   8  18  28
10 1課  A  B  C  D  E  ★   9  19  29
11 1課  A  B  C  D  E  ☆  10  20  30
12 2課  F  G  H  I  J  ▲  11  21  31
13 2課  F  G  H  I  J  △  12  22  32
14 2課  F  G  H  I  J  ●  13  23  33
15 2課  F  G  H  I  J  ○  14  24  34
16 2課  F  G  H  I  J  ■  15  25  35
17 2課  F  G  H  I  J  □  16  26  36
18 2課  F  G  H  I  J  ◆  17  27  37

Sheet2
  A  B  C  D  E  F   G   H   I
                     4月
1 課名 項1 項2 項3 項4 項5  ▲   △   ●
2 1課  A  B  C  D  E   1   2   3
3 2課  F  G  H  I  J  11  12  13
4 3課  K  L  M  N  O  21  22  23

と言う形で組直しました
変更を見れば解る通り、単純に「何処を直せば?」
と言う訳には行きません

元のデータ形式の変更、結果の形式の変更は、簡単に行きません
今回は、真だ少ない方だと思います

Option Explicit

Public Sub AddUp()

  Const lngItem As Long = 10   '費目数       ★この行追加
  Const lngInfor As Long = 6   '課名等の列情報を6個 ★この行追加
  
  Dim i As Long
  Dim rngData As Range
  Dim lngRow As Long
  Dim lngCol As Long
  Dim rngResult As Range
  
  '結果表の左上セル位置を設定
  Set rngResult _
    = Worksheets("Sheet2").Cells(1, "A")
  'データ表の左上セル位置を設定
  Set rngData _
    = Worksheets("Sheet1").Cells(1, "A")
  
  'データ表に就いて
  With rngData
    '月列の数を取得
    lngCol = .End(xlToRight).Column _
          - .Offset(, lngInfor + 1).Column  '★この行変更
    'データ行数を取得
    lngRow = .Offset(, 1).End(xlDown).Row _
              - .Offset(, 1).Row     '★この行変更
  End With
  
  '行見だしを作成
  WriteRowTitle rngData, rngResult, _
          lngRow, lngItem, lngInfor      '★この行変更
  
  '月の列の先頭から最後まで繰り返し
  For i = 0 To lngCol
    '月別に集計
    ListWrite i, rngData, rngResult, _
          lngRow, lngItem, lngInfor
  Next i
  
  Set rngData = Nothing
  Set rngResult = Nothing

  Beep
  MsgBox "処理が完了しました"
  
End Sub

Private Sub ListWrite(ByVal lngRead As Long, _
            rngData As Range, _
            rngResult As Range, _
            lngRow As Long, _
            lngItem As Long, _
            lngInfor As Long)        '★この行変更

  Dim i As Long
  Dim vntData As Variant
  Dim vntResult As Variant
  Dim lngWrite As Long                '★この行追加
  
  '読み込み位置を書き込み列位置に変換
  lngWrite = lngRead * lngItem + lngInfor       '★この行追加
  '読み込み位置を列位置(Offset位置)変換
  lngRead = lngRead + lngInfor + 1          '★この行追加
  
  '出力用配列を確保
  ReDim vntResult(0 To lngRow \ lngItem + 1, _
                0 To lngItem - 1)    '★この行変更
  
  'データ表の左上セルに就いて
  With rngData
    '月名を出力用配列に代入
    vntResult(0, 0) _
        = .Offset(, lngRead).Value       '★この行変更
    '費目を出力用配列に代入
    For i = 1 To lngItem              '★この行追加
      vntResult(1, i - 1) _
          = .Offset(i, lngInfor).Value    '★この行変更
    Next i                     '★この行追加
    'データを配列に取得
    vntData _
      = .Offset(1, lngRead).Resize(lngRow).Value '★この行変更
  End With
  
  'データを出力用配列に書き込み
  For i = 1 To UBound(vntData)
    vntResult((i - 1) \ lngItem + 2, _
          (i - 1) Mod lngItem) _
                = vntData(i, 1)     '★この行変更
  Next i
  
  '出力用配列を出力
  With rngResult.Offset(, lngWrite) '★この行変更
    .Resize(lngRow \ lngItem + 2, _
          lngItem).Value = vntResult     '★この行変更
  End With
  
End Sub

Private Sub WriteRowTitle(rngData As Range, _
            rngResult As Range, _
            lngRow As Long, _
            lngItem As Long, _
            lngInfor As Long)        '★この行変更
            
  Dim i As Long
  Dim j As Long                    '★この行追加
  Dim k As Long                    '★この行追加
  Dim vntData As Variant
  Dim vntResult As Variant
  
  '出力用配列を確保
  ReDim vntResult(0 To lngRow \ lngItem + 1, _
                  0 To lngInfor - 1) '★この行変更
  'データ表の左上セルに就いて
  With rngData
    'データを配列に取得
    vntData = .Resize(lngRow + 1, lngInfor).Value  '★この行変更
  End With
  
  '課名を出力用配列に代入
  For i = 1 To lngInfor                '★この行追加
    vntResult(1, i - 1) = vntData(1, i)       '★この行変更
  Next i                       '★この行追加
  '課を出力用配列に代入
  k = 2                        '★この行追加
  For i = 2 To UBound(vntData)            '★この行変更
    If vntResult(k - 1, 0) <> vntData(i, 1) Then  '★この行追加
      For j = 1 To lngInfor            '★この行追加
        vntResult(k, j - 1) = vntData(i, j)   '★この行変更
      Next j                   '★この行追加
      k = k + 1                  '★この行追加
    End If                     '★この行追加
  Next i
  
  '出力用配列を出力
  rngResult.Resize(lngRow \ lngItem + 2, _
              lngInfor).Value = vntResult '★この行変更
  
End Sub

【15030】Re:集計表の作成について
お礼  美咲  - 04/6/13(日) 22:37 -

引用なし
パスワード
   Hirofumi さん、途中でひっくり返すことを聞いて
しまいごめんなさい! 最初からきちんと欲しい
集計表を書けば良かったです。
Hirofumi さんが書いて下さったSheet1のデータ並び
の通りです。今からやってみます。
本当にありがとうございます。
また分からなくなったらぜひ教えて下さい!

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