Excel VBA質問箱 IV

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

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


10919 / 76734 ←次へ | 前へ→

【71358】Re:ソート→集計をマクロで
発言  Hirofumi  - 12/2/24(金) 19:40 -

引用なし
パスワード
   こんなのでは?
「コード」で整列して、1行づつ処理しています

Option Explicit

Public Sub Sample_1()

  'Listの列数(A〜F列)
  Const clngColumns As Long = 6
  'Listの中の「コード」と成る列位置(基準列からの列Offset:0列目)
  Const clngKey1 As Long = 0
  
  Dim i As Long
  Dim lngRows As Long
  Dim lngWrite As Long
  Dim rngList As Range
  Dim rngResult As Range
  Dim vntData As Variant
  Dim vntSum As Variant
  Dim vntTotal As Variant
  Dim strProm As String

  '【集計】の先頭セル位置を基準とする(先頭列の列見出しのセル位置)
  Set rngList = Worksheets("集計").Range("A1")

  '【合計集計】の結果出力の先頭セル位置を基準とする(先頭列の列見出しのセル位置)
  Set rngResult = Worksheets("合計集計").Range("A1")
  
  '画面更新を停止
  Application.ScreenUpdating = False
  
  '【集計】のListに就いて
  With rngList
    '行数の取得
    lngRows = .Offset(Rows.Count - .Row, clngKey1).End(xlUp).Row - .Row
    If lngRows <= 0 Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
    'Listを「コード」順で整列
    .Offset(1).Resize(lngRows, clngColumns).Sort _
        Key1:=.Offset(1, clngKey1), Order1:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, SortMethod:=xlStroke
  End With
  
  '【合計集計】に就いて
  With rngResult
    'データをクリア
    If .CurrentRegion.Rows.Count > 1 Then
      Intersect(.CurrentRegion, .CurrentRegion.Offset(1)).ClearContents
    End If
  End With
  
  '合計用の配列を確保
  ReDim vntTotal(1 To clngColumns)
  vntTotal(1) = "合計"
  
  '【集計】のデータ先頭行を集計用配列に取得
  vntSum = rngList.Offset(1).Resize(, clngColumns).Value
  '【集計】のデータ2行目〜最終行+1まで繰り返し
  For i = 2 To lngRows + 1
    '1行分のデータを配列に取得
    vntData = rngList.Offset(i).Resize(, clngColumns).Value
    '「コード」が同じなら
    If vntData(1, clngKey1 + 1) = vntSum(1, clngKey1 + 1) Then
      '「個数」「金額」を集計
      vntSum(1, 5) = vntSum(1, 5) + vntData(1, 5)
      vntSum(1, 6) = vntSum(1, 6) + vntData(1, 6)
    Else
      '合計を集計
      vntTotal(5) = vntTotal(5) + vntSum(1, 5)
      vntTotal(6) = vntTotal(6) + vntSum(1, 6)
      'データを出力
      lngWrite = lngWrite + 1
      rngResult.Offset(lngWrite).Resize(, clngColumns).Value = vntSum
      '読み込んだデータを集計用変数に代入
      vntSum = vntData
    End If
  Next i
  
  '合計を出力
  lngWrite = lngWrite + 1
  rngResult.Offset(lngWrite).Resize(, clngColumns).Value = vntTotal
  
  strProm = "処理が完了しました"
   
Wayout:

  '画面更新を再開
  Application.ScreenUpdating = True
  
  Set rngList = Nothing
  Set rngResult = Nothing
   
  MsgBox strProm, vbInformation
     
End Sub
2 hits

【71348】ソート→集計をマクロで ゆうか 12/2/24(金) 13:35 質問
【71356】Re:ソート→集計をマクロで UO3 12/2/24(金) 19:36 回答
【71357】Re:ソート→集計をマクロで UO3 12/2/24(金) 19:39 回答
【71362】Re:ソート→集計をマクロで ゆうか 12/2/25(土) 1:03 質問
【71370】Re:ソート→集計をマクロで UO3 12/2/25(土) 14:19 発言
【71372】Re:ソート→集計をマクロで UO3 12/2/25(土) 19:01 発言
【71374】Re:ソート→集計をマクロで UO3 12/2/26(日) 1:38 発言
【71404】Re:ソート→集計をマクロで ゆうか 12/2/29(水) 15:01 質問
【71414】Re:ソート→集計をマクロで UO3 12/3/1(木) 10:17 回答
【71424】Re:ソート→集計をマクロで ゆうか 12/3/1(木) 13:12 発言
【71433】Re:ソート→集計をマクロで UO3 12/3/2(金) 11:26 発言
【71434】Re:ソート→集計をマクロで UO3 12/3/2(金) 11:43 回答
【71358】Re:ソート→集計をマクロで Hirofumi 12/2/24(金) 19:40 発言
【71361】Re:ソート→集計をマクロで ゆうか 12/2/25(土) 0:56 質問

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