★★★★クロス集計表や帳票をリスト形式に変換するのに、ワークシート関数とVBAプログラムとどちらがいいのか？～答えのひとつとしては、「3枚以下の表ならワークシート関数」が良い気がしますし、同じ表が３枚以上あるならセルに関数式を埋めることすら面倒くさいので、「VBAプログラム」を検討してもOKだと思います。 | 無駄なお金と時間がない方・零細企業様・独立したい方・個人事業主の方・営業さん・経理さん・学生さん・就活生さん・小学生のお子様、中高生の子たちのための、　　　　「小さな会社の兼任なんちゃって社内SE・パソコン管理術・の基礎知識」

★★★★クロス集計表や帳票をリスト形式に変換するのに、ワークシート関数とVBAプログラムとどちらがいいのか？～答えのひとつとしては、「3枚以下の表ならワークシート関数」が良い気がしますし、同じ表が３枚以上あるならセルに関数式を埋めることすら面倒くさいので、「VBAプログラム」を検討してもOKだと思います。
　　
★ サンプルファイルのダウンロード

こちら ← からダウンロードできます。
　　
　　

★ はじめに

「クロス集計表や帳票をリスト形式の表に変換したい」という要望があることが少なくないと思います。（データクレンジング？と言ったりもするのかしら？）

理由は、
（特にクロス集計表を変換したい場合は）

・リスト形式の表に変換すると、モトのクロス集計表の集計とは別に、

・数倍～十数倍、場合によっては数十倍の、

・「異なる切り口での」クロス集計表が「さらに作成できる」から。

です。
　　

で、その場合、方法は大別して２つあると思います。

(a)ワークシート関数を使う方法
(b)VBAプログラムを使う方法

※補足
(a)と(b)のほかには、「パワークエリ」を使う方法もあると思います。
が、「かなりイレギュラーなレイアウト」には対応しづらいのではないか？とも思うので、今回は説明していません。というか、僕も簡単な例しか使ったことないので、よくわかっていません。すみません。
が、今回ココで紹介しているサンプル程度のレイアウトの表なら、もしかしたら「パワークエリ」が一番早く済むかもしれません。
なので、「パワークエリ」も絶対に使えるほうがいいには決まっています。
ただ、もちろん、変換したい表の数が、1～5枚くらいだけなら・・・ということになりますので、例えば毎回50枚以上処理しないといけない、等々の状況なら、VBAのほうが早いと思います。
VBAも意外と少ないコード量で済むこともありますので。
なお、本当にシンプルなクロス集計表（列名や行名が1段づつしかないとか）なら、ピボットテーブルでもクロス集計表からリスト形式の表に変換できます。
シンプルなものは是非ピボットも試していただきたいと思います。

※2021/06/16追記
「パワークエリ」、少し触ってみました。かなり便利です。

PowerQuery【01】PowerQuery（パワークエリー）で出来ること

PowerQuery【01】PowerQuery（パワークエリー）で出来ること

が、やはり「考え方が難しい」です。ワークシート関数だけでなく、SQLやVBA、さらにはピボットテーブルにも使い慣れてないとなかなか使いこなせない代物でした。今回のレイアウトでも、「相当パワークエリを使い込んで慣れている」という人しか「カンタン」にはできません。使いこなせれば超便利ですが、「超簡単なことは、確かに簡単なんだけど」、でもそうじゃなくて、それ以外のことは、「ほんの少し難易度が上がった要求を実現したいだけなのに」「ぶっちゃけVBAよりも難易度が上がる」という感じでした。
正直、「VBA＋SQL+専用の各種オブジェクトやメソッド」のほうが「早いし」「速いな」というケースも少なくないです。
（何よりもそっちのほうが「修正」が「わかりやすい」です。）
「パワークエリ」を、安易に「カンタン」って言う人って、ExcelVBAで「SQL」を使ったことが無い人で、かつ、大した処理してない人、だけだと思います。
「VBAで作る手間と、パワークエリのクセ・作法の難しさを克服するのと、どっともどっちだなあ」という感じです。
上記のWebサイトに、『 Accessを使い慣れている方なら30分～1時間・VLOOKUP関数を使っている【のみ】なら1時間以上はかかるように思います。』と書かれていますが、冗談じゃないです。「Accessを使い慣れている方」ってどのくらいのレベルかご存じですか？
でもそんな人でも、パワークエリを「30分～1時間さわっててできることって」、「ゴミみたいな簡単なレベル」のことしかできません。そして、ちょっと突っ込み始めるととたんに「すごくめんどくさくなる」です。「なんだ？この仕様・・・」ってなります。「慣れると簡単」という段階に行くまで1年はかかると思います。
画面のボタンの（用語）の訳・意味がわかりづらすぎて。
「パワークエリ」は、とにかく「わかりにくい」です。SQLに似てますが、究極に「わかりにくい」、です。
VBAと同じかそれ以上のスキルを要求されます。
正直、VBA＋SQLは「手順や文章の量が多い」「だけ」で、「修正や作り替え」はパワークエリよりもラクです。
普通の事務職で、ワークシート関数だけしか触ったことがない人には、かなり敷居が高いと思います。
ただ、SQLと同じで、そのようなレベルの方でも簡単に便利に操作できる部分もあるにはあるので、怖がらずにチャレンジすれば、思いもかけない素敵な風景が広がります。がんばってチャレンジしてみてください。
（50個のエクセルファイルをまとめるときも、50個が全部同じレイアウトならVBAよりも早いケースも少なくありません。同じレイアウトのファイルなら、フォルダにファイルが100個に増えても何にもしなくても自動で処理してくれる場合もあります。でも、数個、レイアウトが異なるとやはり面倒くさいことになります。）
　　

すみません、また脱線が長引いてしまいました。

話をもとに戻します。

冒頭の(a)と(b)、どちらも有効な方法だと思いますが、それぞれに良さがあると思います。

基本、
(a)の「ワークシート関数を使う方法」では、
処理するシートの数が少なければ少ないほど、有効だと思います。

それに対して、
(b)のVBAプログラムを使う方法は
処理するシートの数が多ければ多いほど、有効・・・、だと思います。

例えば、処理したいシートが50シートある場合を考えてみます。

その場合、
「それをリスト表に1枚ずつ変換し、さらには全部を縦に結合（マージ）したい」というような場合、シート1枚1枚にワークシート関数を含んだ数式を、全部で50枚、いちいちセルに埋め込んでいく・・・」
というのはかなり大変な作業で、数式の設定ミスも発生しやすいです。

それを50枚縦に結合するという話になったら、さらにミスが発生しかねません。

さらには、「手作業だと」50枚結合したものが正しく結合されているかのチェックも必要になってしまいます。（1行分だけ抜けてた・・・とかのミスがあると非常に見つけづらいです。）

VBAなら、全自動になります。
また、チェックするのも、これもVBAで行えるので、ラクに行えると思います。
　　

逆に、処理したいシートが1枚しかないのに、わざわざVBAにする必要もない、というケースも多々あります。

ただ、VBAプログラムが理解できるのなら、サンプルをいったん組んでおけば、「意外にも」、「あとは少し部分修正するだけ・部分的に組み替えるだけ」なことも少なくないので、「意外にも困難」ではなく、「処理したいシートが1枚」のときでも、もちろんVBAプログラムは有効です。

が、サンプルプログラムが無いときや、VBAプログラミンング自体がまだ未経験の場合は、やはりワークシート関数が生きてきます。

以上のように、「どちらかひとつだけで全部やろうとする」と、ロス・ムリ・ムダ・ムラ、を生んでしまうので、本当は両方できたほうがいいです。

本記事では、そのような場合に、「VBAプログラミングでの処理のひな型」として使って頂けるサンプルをご紹介するとともに、「ワークシート関数」での処理のサンプルもさらっとご紹介だけしたいと思います。（僕は逆にワークシート関数が苦手です。VBAのループも苦手だけど・・・）

★ 変形前のクロス集計表のレイアウト

サンプルのExcelファイルの中には大きくは４つシートがありますが、最初の３つは以下のようなパターンの変換になります。

最後の１つのシートは以下のような変換パターンになります。

３つのシートの方の、VBAプログラムで変換したものを、少しソースのレイアウトを変えたものです。
それによってプログラㇺがどのくらい変化するかを見てみてください。
意外と変化しないことが分かると思います。（もちろんそんなケースばかりでは無いとは思いますが・・・。）
　　
　　

★ 「関数で01MOD関数などでの方法」シートについて
【欲しいデータベースを作る】クロス集計表をリスト形式の表に変換する方法
に記された方法をそのまま試しています。
（ちょっとセル位置や、変換先の表示形式などが異なりますが）

★ 「関数で02_INDEX関数を使う方法」シートについて

「Excel 多量データ整形テクニック」の「階層並列表」の項（P108あたり）のやり方でやっています。

★ 「VBAで01テスト」シートについて

以降のようなコードで処理しています。

このサンプルだけを見ると、これだけのコード量でいいなら、ワークシート関数でやるのとどっちがいいのだろう？と考えたくなります。

でも、「ワークシート関数を使うほうがVBAよりも便利なレイアウト」のケースも絶対にあると思うので、VBAの妄信は危険だとも思います。

'
'
Sub test002_DellComment()
'コメントを減らしただけの内容。「test002」とまったく同じです。
'行の見出しが３つとか４つとか増えたら、「For k = 0 To 2」のループの中で、
'転記のコードがひとつ増えるだけ。
'ただし、「2行分で1レコード相当」というレイアウトになっていると
'さらに複雑にならざるを得ないかも？
'また、年月が列名の第一カテゴリで、数量と売り上げが第二カテゴリになっていたら
'違うコードになります。


    Dim SrcWS01     As Worksheet
    Dim TrgWS01     As Worksheet
    Dim SCel01      As Range
    Dim SCel02      As Range
    Dim SCel03      As Range
    Dim SCel04      As Range
    Dim SCel05      As Range
    Dim TCel01      As Range
    Dim j           As Long
    Dim k           As Long
    Dim l           As Long
   
   
    Set SrcWS01 = Application.ThisWorkbook.Worksheets("VBAで01テスト")
    Set TrgWS01 = Application.ThisWorkbook.Worksheets("VBAで01テスト")
    

    Set SCel01 = SrcWS01.Range("B4")  '「果物」のセル
    Set SCel02 = SrcWS01.Range("C4")  '「りんご」のセル
    Set SCel03 = SrcWS01.Range("D3")  '「2019年8月」のセル
    Set SCel04 = SrcWS01.Range("D4")  '「50」のセルを、その行×３列分の起点にする。
    Set SCel05 = SrcWS01.Range("G4")  '「5000」のセル、その行×３列分の起点にする。
    

    Set TCel01 = TrgWS01.Range("K4")
    
    TCel01.Range(Cells(1, 1), Cells(20, 6)).ClearContents

    
    l = 0
    
    
    For j = 0 To 4
        
        
        For k = 0 To 2
            
           
'            TCel01.Offset(l, 0).Value = Range(GetMrgCelAddr_Fst02(Cells(4 + j, 2))).Value
'            TCel01.Cells(l, 1).Value = SrcWS01.Range(GetMrgCelAddr_Fst02(SrcWS01.Cells(3 + j, 2))).Value
            TCel01.Offset(l, 0).Value = SrcWS01.Range(GetMrgCelAddr_Fst02(SrcWS01.Cells(4 + j, 2))).Value
            
            TCel01.Offset(l, 1).Value = SCel02.Offset(j, 0)
              
            TCel01.Offset(l, 2).Value = SCel03.Offset(0, k)
            TCel01.Offset(l, 2).NumberFormat = "yyyy/mm"

            TCel01.Offset(l, 3).Value = SCel04.Offset(j, k)
            
            TCel01.Offset(l, 4).Value = SCel05.Offset(j, k)
            
            
            l = l + 1 '転記先の行を次行に送る。
        
        Next k
        
        
    Next j
    
    
    '列名の入力
    TCel01.Offset(-1, 0) = "カテゴリ"
    TCel01.Offset(-1, 1) = "品名"
    TCel01.Offset(-1, 2) = "日付"
    TCel01.Offset(-1, 3) = "数量"
    TCel01.Offset(-1, 4) = "売上"


End Sub



'#################################################################
'結合セルの先頭セルのアドレスを取得する自作関数
'縦の結合、横の結合、どちらでも。
'結合されてなかったら、そのセルのアドレスを返します。
'#################################################################
 
Function GetMrgCelAddr_Fst02(o_SingleCel As Range) As String
 
    Dim s_MargAddr As String
    
    If o_SingleCel.MergeCells = True Then
    
        s_MargAddr = o_SingleCel.MergeArea.Address
        GetMrgCelAddr_Fst02 = LTrimWrd(s_MargAddr, ":")
        
    Else
    
        GetMrgCelAddr_Fst02 = o_SingleCel.Address
        
    End If
    
End Function
 
 
 
'#################################################################
'特定の、指定した文字を境に、その左側の文字列を切り出す自作関数
'今回は「$A$1:$C$1」のようなセル範囲の「:」よりも左のアドレスを
'取得するのに使います
'#################################################################
 
 
Function LTrimWrd(s_Wrd01 As String, s_DlmtChr01 As String) As String
 
    Dim i_DlmtPos As Integer
    
    i_DlmtPos = InStr(1, s_Wrd01, s_DlmtChr01, vbBinaryCompare)
    LTrimWrd = Left(s_Wrd01, i_DlmtPos - 1)
    
    
End Function



'
'

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

Sub test002_DellComment()

'コメントを減らしただけの内容。「test002」とまったく同じです。

'行の見出しが３つとか４つとか増えたら、「For k = 0 To 2」のループの中で、

'転記のコードがひとつ増えるだけ。

'ただし、「2行分で1レコード相当」というレイアウトになっていると

'さらに複雑にならざるを得ないかも？

'また、年月が列名の第一カテゴリで、数量と売り上げが第二カテゴリになっていたら

'違うコードになります。

Dim SrcWS01 As Worksheet

Dim TrgWS01 As Worksheet

Dim SCel01 As Range

Dim SCel02 As Range

Dim SCel03 As Range

Dim SCel04 As Range

Dim SCel05 As Range

Dim TCel01 As Range

Dim j As Long

Dim k As Long

Dim l As Long

Set SrcWS01 = Application.ThisWorkbook.Worksheets("VBAで01テスト")

Set TrgWS01 = Application.ThisWorkbook.Worksheets("VBAで01テスト")

Set SCel01 = SrcWS01.Range("B4") '「果物」のセル

Set SCel02 = SrcWS01.Range("C4") '「りんご」のセル

Set SCel03 = SrcWS01.Range("D3") '「2019年8月」のセル

Set SCel04 = SrcWS01.Range("D4") '「50」のセルを、その行×３列分の起点にする。

Set SCel05 = SrcWS01.Range("G4") '「5000」のセル、その行×３列分の起点にする。

Set TCel01 = TrgWS01.Range("K4")

TCel01.Range(Cells(1, 1), Cells(20, 6)).ClearContents

l = 0

For j = 0 To 4

For k = 0 To 2

' TCel01.Offset(l, 0).Value = Range(GetMrgCelAddr_Fst02(Cells(4 + j, 2))).Value

' TCel01.Cells(l, 1).Value = SrcWS01.Range(GetMrgCelAddr_Fst02(SrcWS01.Cells(3 + j, 2))).Value

TCel01.Offset(l, 0).Value = SrcWS01.Range(GetMrgCelAddr_Fst02(SrcWS01.Cells(4 + j, 2))).Value

TCel01.Offset(l, 1).Value = SCel02.Offset(j, 0)

TCel01.Offset(l, 2).Value = SCel03.Offset(0, k)

TCel01.Offset(l, 2).NumberFormat = "yyyy/mm"

TCel01.Offset(l, 3).Value = SCel04.Offset(j, k)

TCel01.Offset(l, 4).Value = SCel05.Offset(j, k)

l = l + 1 '転記先の行を次行に送る。

Next k

Next j

'列名の入力

TCel01.Offset(-1, 0) = "カテゴリ"

TCel01.Offset(-1, 1) = "品名"

TCel01.Offset(-1, 2) = "日付"

TCel01.Offset(-1, 3) = "数量"

TCel01.Offset(-1, 4) = "売上"

End Sub

'#################################################################

'結合セルの先頭セルのアドレスを取得する自作関数

'縦の結合、横の結合、どちらでも。

'結合されてなかったら、そのセルのアドレスを返します。

'#################################################################

Function GetMrgCelAddr_Fst02(o_SingleCel As Range) As String

Dim s_MargAddr As String

If o_SingleCel.MergeCells = True Then

s_MargAddr = o_SingleCel.MergeArea.Address

GetMrgCelAddr_Fst02 = LTrimWrd(s_MargAddr, ":")

Else

GetMrgCelAddr_Fst02 = o_SingleCel.Address

End If

End Function

'#################################################################

'特定の、指定した文字を境に、その左側の文字列を切り出す自作関数

'今回は「$A$1:$C$1」のようなセル範囲の「:」よりも左のアドレスを

'取得するのに使います

'#################################################################

Function LTrimWrd(s_Wrd01 As String, s_DlmtChr01 As String) As String

Dim i_DlmtPos As Integer

i_DlmtPos = InStr(1, s_Wrd01, s_DlmtChr01, vbBinaryCompare)

LTrimWrd = Left(s_Wrd01, i_DlmtPos - 1)

End Function

★ 「VBAで02test」シートについて

以降のようなコードで処理しています。
「GetMrgCelAddr_Fst02()」関数と、「LTrimWrd」関数は前項のコードとまったく同じです。
前項のコードとの行数だけでも比べてみてください。
思ったよりも増えてないと感じるのではないかと思います。

'
'
Sub test004_DellComment()
'コメントを減らしただけの内容。「test002」とまったく同じです。
'行の見出しが３つとか４つとか増えたら、「For k = 0 To 2」のループの中で、
'転記のコードがひとつ増えるだけ。
'ただし、「2行分で1レコード相当」というレイアウトになっていると
'さらに複雑にならざるを得ないかも？
'また、年月が列名の第一カテゴリで、数量と売り上げが第二カテゴリになっていたら
'違うコードになります。


    Dim SrcWS01     As Worksheet
    Dim TrgWS01     As Worksheet
    
    Dim SCel01      As Range
    Dim SCel02      As Range
    Dim SCel03      As Range
    Dim SCel04      As Range
    Dim SCel05      As Range
    
    Dim TCel01      As Range
    
    Dim j           As Long
    Dim k           As Long
    Dim l           As Long

    Dim n As Long
   

    Set SrcWS01 = Application.ThisWorkbook.Worksheets("VBAで02test")
    Set TrgWS01 = Application.ThisWorkbook.Worksheets("VBAで02test")

    Set SCel01 = SrcWS01.Range("B4")  '「果物」のセル。
    Set SCel02 = SrcWS01.Range("C4")  '「りんご」のセル。
    Set SCel03 = SrcWS01.Range("D2")  '「2019年8月」のセルを、その行×３列分の起点にする。
    Set SCel04 = SrcWS01.Range("D4")  '「50」のセルを、その行×３列分の起点にする。
    Set SCel05 = SrcWS01.Range("E4")  '「5000」のセル、その行×３列分の起点にする。
    
    '※数量と売り上げの年月の並びが同じなので、×３列分として処理します。
    
    Set TCel01 = TrgWS01.Range("K4")

    TCel01.Range(Cells(1, 1), Cells(20, 6)).ClearContents
    
    l = 0

    
    For j = 0 To 4
    
        n = 0  'ソース１行ごとに「n」（列の移動）を初期化
        
        For k = 0 To 2

'            TCel01.Offset(l, 0).Value = Range(GetMrgCelAddr_Fst02(Cells(4 + j, 2))).Value
'            TCel01.Cells(l, 1).Value = SrcWS01.Range(GetMrgCelAddr_Fst02(SrcWS01.Cells(3 + j, 2))).Value
            TCel01.Offset(l, 0).Value = SrcWS01.Range(GetMrgCelAddr_Fst02(SrcWS01.Cells(4 + j, 2))).Value
            
            TCel01.Offset(l, 1).Value = SCel02.Offset(j, 0)
            
                TCel01.Offset(l, 2).Value = Range(GetMrgCelAddr_Fst02(SCel03.Offset(0, n)))
                TCel01.Offset(l, 2).NumberFormat = "yyyy/mm"
                        
                TCel01.Offset(l, 3).Value = SCel04.Offset(j, n)
                
                TCel01.Offset(l, 4).Value = SCel05.Offset(j, n)
                
                n = n + 2
            
            l = l + 1 '転記先の行を次行に送る。
            
            
            
        Next k
        
        
    Next j
    
    
    '列名の入力
    TCel01.Offset(-1, 0) = "カテゴリ"
    TCel01.Offset(-1, 1) = "品名"
    TCel01.Offset(-1, 2) = "日付"
    TCel01.Offset(-1, 3) = "数量"
    TCel01.Offset(-1, 4) = "売上"


End Sub
'
'

Sub test004_DellComment()

'コメントを減らしただけの内容。「test002」とまったく同じです。

'行の見出しが３つとか４つとか増えたら、「For k = 0 To 2」のループの中で、

'転記のコードがひとつ増えるだけ。

'ただし、「2行分で1レコード相当」というレイアウトになっていると

'さらに複雑にならざるを得ないかも？

'また、年月が列名の第一カテゴリで、数量と売り上げが第二カテゴリになっていたら

'違うコードになります。

Dim SrcWS01 As Worksheet

Dim TrgWS01 As Worksheet

Dim SCel01 As Range

Dim SCel02 As Range

Dim SCel03 As Range

Dim SCel04 As Range

Dim SCel05 As Range

Dim TCel01 As Range

Dim j As Long

Dim k As Long

Dim l As Long

Dim n As Long

Set SrcWS01 = Application.ThisWorkbook.Worksheets("VBAで02test")

Set TrgWS01 = Application.ThisWorkbook.Worksheets("VBAで02test")

Set SCel01 = SrcWS01.Range("B4") '「果物」のセル。

Set SCel02 = SrcWS01.Range("C4") '「りんご」のセル。

Set SCel03 = SrcWS01.Range("D2") '「2019年8月」のセルを、その行×３列分の起点にする。

Set SCel04 = SrcWS01.Range("D4") '「50」のセルを、その行×３列分の起点にする。

Set SCel05 = SrcWS01.Range("E4") '「5000」のセル、その行×３列分の起点にする。

'※数量と売り上げの年月の並びが同じなので、×３列分として処理します。

Set TCel01 = TrgWS01.Range("K4")

TCel01.Range(Cells(1, 1), Cells(20, 6)).ClearContents

l = 0

For j = 0 To 4

n = 0 'ソース１行ごとに「n」（列の移動）を初期化

For k = 0 To 2

' TCel01.Offset(l, 0).Value = Range(GetMrgCelAddr_Fst02(Cells(4 + j, 2))).Value

' TCel01.Cells(l, 1).Value = SrcWS01.Range(GetMrgCelAddr_Fst02(SrcWS01.Cells(3 + j, 2))).Value

TCel01.Offset(l, 0).Value = SrcWS01.Range(GetMrgCelAddr_Fst02(SrcWS01.Cells(4 + j, 2))).Value

TCel01.Offset(l, 1).Value = SCel02.Offset(j, 0)

TCel01.Offset(l, 2).Value = Range(GetMrgCelAddr_Fst02(SCel03.Offset(0, n)))

TCel01.Offset(l, 2).NumberFormat = "yyyy/mm"

TCel01.Offset(l, 3).Value = SCel04.Offset(j, n)

TCel01.Offset(l, 4).Value = SCel05.Offset(j, n)

n = n + 2

l = l + 1 '転記先の行を次行に送る。

Next k

Next j

'列名の入力

TCel01.Offset(-1, 0) = "カテゴリ"

TCel01.Offset(-1, 1) = "品名"

TCel01.Offset(-1, 2) = "日付"

TCel01.Offset(-1, 3) = "数量"

TCel01.Offset(-1, 4) = "売上"

End Sub

★ 「test002_DellComment()」の、コメントつきのコード

以下、①と②も３回繰り返します。
（つまり、りんご１行分につき、果物とりんごを３回繰り返します。）

※結局、下図のように、「１行単位で」、矢印などを書いて動きを視覚化してみると、ループのプログラムが作りやすいかもしれません。

'
'
Sub test002()

    Dim SrcWS01     As Worksheet
    Dim TrgWS01     As Worksheet
    
    Dim SCel01      As Range  'ソース
    Dim SCel02      As Range
    Dim SCel03      As Range
    Dim SCel04      As Range
    Dim SCel05      As Range
    
    Dim TCel01      As Range  'ターゲット
    
    Dim j           As Long   'ソースを縦に読み込むためのカウンタ
    Dim k           As Long   'ソースを横に読み込んで、ターゲットに
                                    '１レコード分ずつに整形して書き出すためのカウンタ
    Dim l           As Long   'ターゲット領域に、全レコードを書き出すときの、
                                    '次行へインクリメントするためのカウンタ

   
'    Set SrcWS01 = Application.ThisWorkbook.Worksheets.Item("Sheet1")
'    Set TrgWS01 = Application.ThisWorkbook.Worksheets.Item("Sheet3")
    Set SrcWS01 = Application.ThisWorkbook.ActiveSheet
    Set TrgWS01 = Application.ThisWorkbook.ActiveSheet
    '↑ソースのシートと転記先のシートの設定
    

    Set SCel01 = SrcWS01.Range("B4")  '「果物」のセルを、その列の転記の起点にする。
    Set SCel02 = SrcWS01.Range("C4")  '「りんご」のセルを、その列の転記の起点にする。
    Set SCel03 = SrcWS01.Range("D3")  '「2019年8月」のセルを、その行×３列分の起点にする。
    Set SCel04 = SrcWS01.Range("D4")  '「50」のセルを、その行×３列分の起点にする。
    Set SCel05 = SrcWS01.Range("G4")  '「5000」のセル、その行×３列分の起点にする。
    
    '※数量と売り上げの年月の並びが同じなので、×３列分として処理します。
    
    
'    Set TCel01 = TrgWS01.Cells(4, 11)
    Set TCel01 = TrgWS01.Range("K4")
    '↑転記先の起点セルの設定（どのセルから転記し始めるかの設定）
    
    TCel01.Range(Cells(1, 1), Cells(20, 6)).ClearContents
    '一応、クリア（20、と6、はテキトー）
    
    l = 0
    '↑転記先の行を指定するための、インクリメントし続けるカウンタの初期化
    
    
    For j = 0 To 4  '縦のループ。ソースが５行分あるので、0～4で5回分ループする。
                    'Offsetを使って転記するのでループの開始を「0」にする。
        
        
        For k = 0 To 2  '横のループ。
                        '数量と売上の列の１セットで、３列ごとの繰り返しなので、
                        '0～2で、１行当たり3回ずつループする。
                        'こちらのループも Offsetを使って転記するのでループの開始を「0」にする。

            
            '以下、転記処理
            'ソースの１行ずつを転記。
            
'            TCel01.Offset(l, 0).Value = Range(GetMrgCelAddr_Fst02(Cells(4 + j, 2))).Value
'            TCel01.Cells(l, 1).Value = SrcWS01.Range(GetMrgCelAddr_Fst02(SrcWS01.Cells(3 + j, 2))).Value
            TCel01.Offset(l, 0).Value = SrcWS01.Range(GetMrgCelAddr_Fst02(SrcWS01.Cells(4 + j, 2))).Value
            '↑果物、お菓子、の列の転記。
            
            TCel01.Offset(l, 1).Value = SCel02.Offset(j, 0)
            '↑りんごの列は縦にループするので列は変化なしなので、
            '　Offsetの列のところには「0」を使って固定。
              
            TCel01.Offset(l, 2).Value = SCel03.Offset(0, k)
            TCel01.Offset(l, 2).NumberFormat = "yyyy/mm"
            '↑年月の列は横にループするので、行は変化なしなので、
            '　Offsetの行のところには「0」を使って固定。
            '  ついでに、書式も「yyyy/mm」表示に。でないとシリアル値になってしまうので。
            
            TCel01.Offset(l, 3).Value = SCel04.Offset(j, k)
            '↑数量の列は横から縦にループするので、
            '　Offsetの行のところには「j」、列のところには「k」を使う。
            
            TCel01.Offset(l, 4).Value = SCel05.Offset(j, k)
            '↑同上。
            
            
            l = l + 1 '転記先の行を次行に送る。
        
        Next k
        
        
    Next j
    
    
    '列名の入力
    TCel01.Offset(-1, 0) = "カテゴリ"
    TCel01.Offset(-1, 1) = "品名"
    TCel01.Offset(-1, 2) = "日付"
    TCel01.Offset(-1, 3) = "数量"
    TCel01.Offset(-1, 4) = "売上"


End Sub







'
'

100

101

102

103

104

105

106

107

108

109

110

111

Sub test002()

Dim SrcWS01 As Worksheet

Dim TrgWS01 As Worksheet

Dim SCel01 As Range 'ソース

Dim SCel02 As Range

Dim SCel03 As Range

Dim SCel04 As Range

Dim SCel05 As Range

Dim TCel01 As Range 'ターゲット

Dim j As Long 'ソースを縦に読み込むためのカウンタ

Dim k As Long 'ソースを横に読み込んで、ターゲットに

'１レコード分ずつに整形して書き出すためのカウンタ

Dim l As Long 'ターゲット領域に、全レコードを書き出すときの、

'次行へインクリメントするためのカウンタ

' Set SrcWS01 = Application.ThisWorkbook.Worksheets.Item("Sheet1")

' Set TrgWS01 = Application.ThisWorkbook.Worksheets.Item("Sheet3")

Set SrcWS01 = Application.ThisWorkbook.ActiveSheet

Set TrgWS01 = Application.ThisWorkbook.ActiveSheet

'↑ソースのシートと転記先のシートの設定

Set SCel01 = SrcWS01.Range("B4") '「果物」のセルを、その列の転記の起点にする。

Set SCel02 = SrcWS01.Range("C4") '「りんご」のセルを、その列の転記の起点にする。

Set SCel03 = SrcWS01.Range("D3") '「2019年8月」のセルを、その行×３列分の起点にする。

Set SCel04 = SrcWS01.Range("D4") '「50」のセルを、その行×３列分の起点にする。

Set SCel05 = SrcWS01.Range("G4") '「5000」のセル、その行×３列分の起点にする。

'※数量と売り上げの年月の並びが同じなので、×３列分として処理します。

' Set TCel01 = TrgWS01.Cells(4, 11)

Set TCel01 = TrgWS01.Range("K4")

'↑転記先の起点セルの設定（どのセルから転記し始めるかの設定）

TCel01.Range(Cells(1, 1), Cells(20, 6)).ClearContents

'一応、クリア（20、と6、はテキトー）

l = 0

'↑転記先の行を指定するための、インクリメントし続けるカウンタの初期化

For j = 0 To 4 '縦のループ。ソースが５行分あるので、0～4で5回分ループする。

'Offsetを使って転記するのでループの開始を「0」にする。

For k = 0 To 2 '横のループ。

'数量と売上の列の１セットで、３列ごとの繰り返しなので、

'0～2で、１行当たり3回ずつループする。

'こちらのループも Offsetを使って転記するのでループの開始を「0」にする。

'以下、転記処理

'ソースの１行ずつを転記。

' TCel01.Offset(l, 0).Value = Range(GetMrgCelAddr_Fst02(Cells(4 + j, 2))).Value

' TCel01.Cells(l, 1).Value = SrcWS01.Range(GetMrgCelAddr_Fst02(SrcWS01.Cells(3 + j, 2))).Value

TCel01.Offset(l, 0).Value = SrcWS01.Range(GetMrgCelAddr_Fst02(SrcWS01.Cells(4 + j, 2))).Value

'↑果物、お菓子、の列の転記。

TCel01.Offset(l, 1).Value = SCel02.Offset(j, 0)

'↑りんごの列は縦にループするので列は変化なしなので、

'　Offsetの列のところには「0」を使って固定。

TCel01.Offset(l, 2).Value = SCel03.Offset(0, k)

TCel01.Offset(l, 2).NumberFormat = "yyyy/mm"

'↑年月の列は横にループするので、行は変化なしなので、

'　Offsetの行のところには「0」を使って固定。

' ついでに、書式も「yyyy/mm」表示に。でないとシリアル値になってしまうので。

TCel01.Offset(l, 3).Value = SCel04.Offset(j, k)

'↑数量の列は横から縦にループするので、

'　Offsetの行のところには「j」、列のところには「k」を使う。

TCel01.Offset(l, 4).Value = SCel05.Offset(j, k)

'↑同上。

l = l + 1 '転記先の行を次行に送る。

Next k

Next j

'列名の入力

TCel01.Offset(-1, 0) = "カテゴリ"

TCel01.Offset(-1, 1) = "品名"

TCel01.Offset(-1, 2) = "日付"

TCel01.Offset(-1, 3) = "数量"

TCel01.Offset(-1, 4) = "売上"

End Sub

　　
★ 「test004_DellComment()」の、コメントつきのコード

こちらも、以下、①と②も３回繰り返します。
（つまり、りんご１行分につき、果物とりんごを３回繰り返します。）

※こちらも、下図のように、「１行単位で」、矢印などを書いて動きを視覚化してみると、ループのプログラムが作りやすいかもしれません。

'
'
Sub test004()

    Dim SrcWS01     As Worksheet
    Dim TrgWS01     As Worksheet
    
    Dim SCel01      As Range  'ソース
    Dim SCel02      As Range
    Dim SCel03      As Range
    Dim SCel04      As Range
    Dim SCel05      As Range
    
    Dim TCel01      As Range  'ターゲット
    
    Dim j           As Long   'ソースを縦に読み込むためのカウンタ
    Dim k           As Long   'ソースを横に読み込んで、ターゲットに
                                    '１レコード分ずつに整形して書き出すためのカウンタ
    Dim l           As Long   'ターゲット領域に、全レコードを書き出すときの、
                                    '次行へインクリメントするためのカウンタ

    Dim n As Long
   
'    Set SrcWS01 = Application.ThisWorkbook.Worksheets.Item("Sheet1")
'    Set TrgWS01 = Application.ThisWorkbook.Worksheets.Item("Sheet3")
    Set SrcWS01 = Application.ThisWorkbook.ActiveSheet
    Set TrgWS01 = Application.ThisWorkbook.ActiveSheet
    '↑ソースのシートと転記先のシートの設定
    

    Set SCel01 = SrcWS01.Range("B4")  '「果物」のセルを、その列の転記の起点にする。
    Set SCel02 = SrcWS01.Range("C4")  '「りんご」のセルを、その列の転記の起点にする。
    Set SCel03 = SrcWS01.Range("D2")  '「2019年8月」のセルを、その行×３列分の起点にする。
    Set SCel04 = SrcWS01.Range("D4")  '「50」のセルを、その行×３列分の起点にする。
    Set SCel05 = SrcWS01.Range("E4")  '「5000」のセル、その行×３列分の起点にする。
    
    '※数量と売り上げの年月の並びが同じなので、×３列分として処理します。
    
    
'    Set TCel01 = TrgWS01.Cells(4, 11)
    Set TCel01 = TrgWS01.Range("K4")
    '↑転記先の起点セルの設定（どのセルから転記し始めるかの設定）
    
    TCel01.Range(Cells(1, 1), Cells(20, 6)).ClearContents
    '一応、クリア（20、と6、はテキトー）
    
    l = 0
    '↑転記先の行を指定するための、インクリメントし続けるカウンタの初期化


    
    For j = 0 To 4  '縦のループ。ソースが５行分あるので、0～4で5回分ループする。
                    'Offsetを使って転記するのでループの開始を「0」にする。
    
        n = 0
        
        For k = 0 To 2  '横のループ。日付の項目より右側は、1行あたりで、
                        '2列ごとの3回分の繰り返しなので、0～2で、1行あたり3回ずつループする。
                        'こちらのループも Offsetを使って転記するのでループの開始を「0」にする。

            
            '以下、転記処理
            'ソースの１行ずつを転記。
            
'            TCel01.Offset(l, 0).Value = Range(GetMrgCelAddr_Fst02(Cells(4 + j, 2))).Value
'            TCel01.Cells(l, 1).Value = SrcWS01.Range(GetMrgCelAddr_Fst02(SrcWS01.Cells(3 + j, 2))).Value
            TCel01.Offset(l, 0).Value = SrcWS01.Range(GetMrgCelAddr_Fst02(SrcWS01.Cells(4 + j, 2))).Value
            '↑果物、お菓子、の列の転記。
            
            TCel01.Offset(l, 1).Value = SCel02.Offset(j, 0)
            '↑りんごの列は縦にループするので列は変化なしなので、
            '　Offsetの列のところには「0」を使って固定。
                       
            
            
                TCel01.Offset(l, 2).Value = Range(GetMrgCelAddr_Fst02(SCel03.Offset(0, n)))
                TCel01.Offset(l, 2).NumberFormat = "yyyy/mm"
                '↑年月の列は横にループするので、行は変化なしなので、
                '　Offsetの行のところには「0」を使って固定。
                '  ついでに、書式も「yyyy/mm」表示に。でないとシリアル値になってしまうので。

            
                        
                TCel01.Offset(l, 3).Value = SCel04.Offset(j, n)
                '↑数量の列は横から縦にループするので、
                '　Offsetの行のところには「j」、列のところには「k」を使う。
                
                TCel01.Offset(l, 4).Value = SCel05.Offset(j, n)
                '↑同上。
                
                n = n + 2
               
           
            
            l = l + 1 '転記先の行を次行に送る。
            
            
            
        Next k
        
        
    Next j
    
    
    '列名の入力
    TCel01.Offset(-1, 0) = "カテゴリ"
    TCel01.Offset(-1, 1) = "品名"
    TCel01.Offset(-1, 2) = "日付"
    TCel01.Offset(-1, 3) = "数量"
    TCel01.Offset(-1, 4) = "売上"


End Sub





'
'

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

Sub test004()

Dim SrcWS01 As Worksheet

Dim TrgWS01 As Worksheet

Dim SCel01 As Range 'ソース

Dim SCel02 As Range

Dim SCel03 As Range

Dim SCel04 As Range

Dim SCel05 As Range

Dim TCel01 As Range 'ターゲット

Dim j As Long 'ソースを縦に読み込むためのカウンタ

Dim k As Long 'ソースを横に読み込んで、ターゲットに

'１レコード分ずつに整形して書き出すためのカウンタ

Dim l As Long 'ターゲット領域に、全レコードを書き出すときの、

'次行へインクリメントするためのカウンタ

Dim n As Long

' Set SrcWS01 = Application.ThisWorkbook.Worksheets.Item("Sheet1")

' Set TrgWS01 = Application.ThisWorkbook.Worksheets.Item("Sheet3")

Set SrcWS01 = Application.ThisWorkbook.ActiveSheet

Set TrgWS01 = Application.ThisWorkbook.ActiveSheet

'↑ソースのシートと転記先のシートの設定

Set SCel01 = SrcWS01.Range("B4") '「果物」のセルを、その列の転記の起点にする。

Set SCel02 = SrcWS01.Range("C4") '「りんご」のセルを、その列の転記の起点にする。

Set SCel03 = SrcWS01.Range("D2") '「2019年8月」のセルを、その行×３列分の起点にする。

Set SCel04 = SrcWS01.Range("D4") '「50」のセルを、その行×３列分の起点にする。

Set SCel05 = SrcWS01.Range("E4") '「5000」のセル、その行×３列分の起点にする。

'※数量と売り上げの年月の並びが同じなので、×３列分として処理します。

' Set TCel01 = TrgWS01.Cells(4, 11)

Set TCel01 = TrgWS01.Range("K4")

'↑転記先の起点セルの設定（どのセルから転記し始めるかの設定）

TCel01.Range(Cells(1, 1), Cells(20, 6)).ClearContents

'一応、クリア（20、と6、はテキトー）

l = 0

'↑転記先の行を指定するための、インクリメントし続けるカウンタの初期化

For j = 0 To 4 '縦のループ。ソースが５行分あるので、0～4で5回分ループする。

'Offsetを使って転記するのでループの開始を「0」にする。

n = 0

For k = 0 To 2 '横のループ。日付の項目より右側は、1行あたりで、

'2列ごとの3回分の繰り返しなので、0～2で、1行あたり3回ずつループする。

'こちらのループも Offsetを使って転記するのでループの開始を「0」にする。

'以下、転記処理

'ソースの１行ずつを転記。

' TCel01.Offset(l, 0).Value = Range(GetMrgCelAddr_Fst02(Cells(4 + j, 2))).Value

' TCel01.Cells(l, 1).Value = SrcWS01.Range(GetMrgCelAddr_Fst02(SrcWS01.Cells(3 + j, 2))).Value

TCel01.Offset(l, 0).Value = SrcWS01.Range(GetMrgCelAddr_Fst02(SrcWS01.Cells(4 + j, 2))).Value

'↑果物、お菓子、の列の転記。

TCel01.Offset(l, 1).Value = SCel02.Offset(j, 0)

'↑りんごの列は縦にループするので列は変化なしなので、

'　Offsetの列のところには「0」を使って固定。

TCel01.Offset(l, 2).Value = Range(GetMrgCelAddr_Fst02(SCel03.Offset(0, n)))

TCel01.Offset(l, 2).NumberFormat = "yyyy/mm"

'↑年月の列は横にループするので、行は変化なしなので、

'　Offsetの行のところには「0」を使って固定。

' ついでに、書式も「yyyy/mm」表示に。でないとシリアル値になってしまうので。

TCel01.Offset(l, 3).Value = SCel04.Offset(j, n)

'↑数量の列は横から縦にループするので、

'　Offsetの行のところには「j」、列のところには「k」を使う。

TCel01.Offset(l, 4).Value = SCel05.Offset(j, n)

'↑同上。

n = n + 2

l = l + 1 '転記先の行を次行に送る。

Next k

Next j

'列名の入力

TCel01.Offset(-1, 0) = "カテゴリ"

TCel01.Offset(-1, 1) = "品名"

TCel01.Offset(-1, 2) = "日付"

TCel01.Offset(-1, 3) = "数量"

TCel01.Offset(-1, 4) = "売上"

End Sub

MENU

関連記事

最近の投稿

カテゴリー

MENU

関連記事

最近の投稿

カテゴリー

タグ