投稿/コメントを表示します。

エクセルマクロ・VBA基礎編フォローアップ アドバンスド
商品ごと、年ごとの販売額合計をピボットテーブルのように出力する（その２－２）

morimotoさんの投稿

(投稿ID: 4716)

小川塾長：いつも詳しい解説ありがとうございます。
現在発展編1学習中です。先日基礎編アドバンス演習18で
詳しい添削していただきありがとうございました。
今回は演習20でまたもsum関数で計算算出するコートができました。
まず商品で並び替えして、商品を転記
そして年→商品で並び返し
最後年が変わる前後でsum関数の始期、終期を出して
式挿入しました。仕事でこのようなsum関数を使う場面が多いので
動画18に続いて自装してみました。添削のほどお願いしたく
よろしくお願いします。
Sub GWtoshinarabiake()
'20200509
'ここでは商品順に並び変え、各商品を転記する
Worksheets("自粛練習").Activate
'商品を転記

Dim tate As Integer
Dim key As String
Dim gyo As Integer
Dim mgyo As Integer

mgyo = Range("a" & Rows.Count).End(xlUp).row
tate = 3
key = ""

'年で並び替え
Call Range("a1" & ":" & "f" & mgyo).Sort( _
           key1:=Range("e2"), order1:=xlAscending, _
           Header:=xlYes)

For gyo = 2 To mgyo
   If key <> Range("e" & gyo).Value Then
      key = Range("e" & gyo).Value
      Range("H" & tate).Value = key
      tate = tate + 1
   End If
Next gyo

End Sub

Sub toshishohinnarabikae()
'年→商品で並び替え
Worksheets("自粛練習").Activate

Dim mgyo As Integer
 mgyo = Range("a" & Rows.Count).End(xlUp).row

 Call Range("a1" & ":" & "f" & mgyo).Sort( _
           key1:=Range("b2"), order1:=xlAscending, _
           key2:=Range("e2"), order2:=xlAscending, _
           Header:=xlYes)
End Sub

Sub GWexecise1()
'sum関数で商品-年ごと算出
Worksheets("自粛練習").Activate

Call GWtoshinarabiake
Call toshishohinnarabikae

Dim gyo As Integer
Dim mgyo As Integer
Dim tate As Integer '転記先のタテ位置
Dim yoko As Integer
Dim key As String  '年 & 商品のkey
Dim key1 As String '年のkey
Dim key2 As String '商品のkey
Dim toshi As String '年
Dim shohin As String '商品
Dim srow As Integer  'sum関数の始期
Dim erow As Integer  'sum関数の終期

mgyo = Range("a" & Rows.Count).End(xlUp).row
tate = 3
yoko = 0
key = ""
key1 = ""
key2 = ""
srow = 2

For gyo = 2 To mgyo
 toshi = Range("b" & gyo).Value
 shohin = Range("e" & gyo).Value
 
  If gyo > 2 Then
     
      If key <> toshi & shohin Then
         key = toshi & shohin
        
          If key1 <> toshi Then 'gyo>2の条件下でkeyが変わりtoshiも変わった　　　　　　　　　　　　　とき
             key1 = toshi
               If key2 <> shohin Then 'gyo>2の条件下でtoshiもshohinも変わっ　　　　　　　　　　　　　　　たとき
                  erow = gyo - 1
                  Range(Chr(73 + yoko) & tate).Value = "=sum(F" & srow & " : F" 　　　　　　　　& erow & ")"
                  srow = gyo
                  yoko = yoko + 1
                  tate = 3 '---タテ位置を3にリセット
                  Range(Chr(73 + yoko) & 2).Value = key1 & "年"
                End If
           Else
             'gyo>2の条件下でkeyが変わりshohinが不変のとき
              key2 = shohin
              erow = gyo - 1
              Range(Chr(73 + yoko) & tate).Value = "=sum(F" & srow & " : F" & 　　　　　　　erow & ")"
              srow = gyo
              tate = tate + 1 '下へシフト
           End If
   
       End If
       
   Else 'gyo=2のとき
     Range(Chr(73 + yoko) & 2).Value = toshi & "年"
     key = toshi & shohin
 　 key1 = toshi
     key2 = shohin
  End If

Next gyo
 'For Nextを出た後にラスト分転記
   erow = gyo - 1
   Range(Chr(73 + yoko) & tate).Value = "=sum(F" & srow & " : F" &   erow  & ")"
End Sub

2020/05/11 03:38