◇

取り込んだテキストファイルを集計し、体裁を整えます。→sample-code

1
2

3

4
5

6
7
8
9
10
11

12

13

Option Explicit
Dim i As Integer, n As Long, j As Long
Dim v As Variant
Dim myrng As Range, copyrng As Range
'────────────────────────────↑宣言セクション
Sub 集計()

Application.ScreenUpdating = False
Worksheets(1).Range("G1").CurrentRegion.Clear

　　Call 並替
　　Call 転記
　　Call 数量
　　Call 合計列
　　Call 列計
　　Call 書式

Application.ScreenUpdating = True

End Sub

1
2
3
4

5
6
7
8
9
10
11
12
13

Option Explicitステートメントで、宣言した変数以外は使えないようにします。（任意）
モジュールレベルの変数を宣言する為、「宣言セクション」に変数を宣言します。
集計という名のプロシージャを記述します。
プロシージャ実行中に画面を更新しないよう、ApplicationオブジェクトのScreenUpdatingプロパティの設定値をFalseにします。
念の為、シート1、セルG1のアクティブセル領域をクリアします。（領域に以前のデータが残っていた場合の削除）
Callステートメントを使い、サブルーチン「並替」を呼び出します。
同じく、サブルーチン「転記」を呼び出します。
同じく、サブルーチン「数量」を呼び出します。
同じく、サブルーチン「合計列」を呼び出します
同じく、サブルーチン「列計」を呼び出します。
同じく、サブルーチン「書式」を呼び出します。
ApplicationオブジェクトのScreenUpdatingプロパティの設定値をTrueにし、画面を更新させます。
プロシージャの記述を終了します。

※段階的に分かりやすくする為、Callステートメントを使い、6個のサブルーチンを呼び出しています。
■Callステートメント
　　Call 呼び出すプロシージャ名
他のプロシージャを呼び出すプロシージャを親プロシージャといい、呼び出されるプロシージャをサブルーチンといいます。
単にプロシージャ名を記述しても構いませんが、より明示的にする為、Callステートメントを使用しています。
■ScreenUpdatingプロパティ
　　オブジェクト.ScreenUpdating
その都度セルの値を書き換えていくようなループ処理や、他のシートを参照するような処理の場合、画面がその処理にあわせて更新され、処理速度が遅くなります。画面のちらつきを抑制し、処理速度をアップする為に、ScreenUpdatinngプロパティの値をFalseに設定します。プロシージャの実行が終了すると自動的にTrueに戻りますが、明示的にする為にTrueにするステートメントを記述する方がよいでしょう。
■Option Explicitステートメント
Option Explicitステートメントを使うと、宣言した変数以外は使えなくなります。宣言した変数以外を使うとエラーになりますので、入力ミスを防ぐ事ができます。Option Explicitステートメントはモジュールの先頭に記述します。
また、Option Explicitステートメントを自動的に記述するには、最初から、モジュール画面の[ツール]→[オプション]→[編集]タブの「変数の宣言を強制する」にチェックを付けておきます。

▲Top

1

並替（サブルーチン・1）

1

2

3

Sub 並替()

Range("A1").sort key1:=Range("A1"), Order1:=xlAscending, header:=xlYes

End Sub

1
2
3

並替という名のプロシージャを記述します。
セルA1のアクティブセル領域を選択し、Sortメソッドでデータの並び替えを行います。
プロシージャの記述を終了します。

後から呼び出しするサブルーチン、「転記」・「数量」用にデータの並び替えをします。
A列の「商品番号」を基に昇順に並び替える処理。降順の場合は、Order:=xlDescending
headerの定数として、
　「xlGuess」= 見出しがあるかどうかをExcelが判断します。
　「xlNO」= 指定範囲全体を並べ替えます。 [規定値]
　「xlYes」= 範囲の先頭行（見出し行）を除いた範囲を並べ替えます。

■Sortメソッド
データを並べ替えるにはSortメソッドを使用します。また、並べ替えの基準となる列を3つまで指定できます。

オブジェクト.Sort(Key1, Order1,Key2, Type, Order2, Key3, Order3, Header, OrderCustom, MatchCase, Orientation, SortMethod, DataOption1, DataOption2, DataOption3)

※オブジェクト・・・Rangeオブジェクトを指定。単体のセルを指定した場合、そのセルを含むアクティブセル領域が並べ替えの対象になります。

■Sub 並替()を実行した結果

2

転記（サブルーチン・2）

1
2
3

4
5
6

7

Sub 転記()
i = 0
i = Range("A65536").End(xlUp).Row

Set copyrng = Range("G1")
Set myrng = Range(Cells(1, 1), Cells(i, 3))
myrng.AdvancedFilter xlFilterCopy, , copyrng, unique:=True

End Sub

1
2
3

4
5
6
7

転記という名のプロシージャを記述します。
変数 i を初期化します。
Endプロパティを使い最下行（A列65536行目）を基準として、そこからデータの入力されている上端のセルを参照しその、行番号を変数 i に代入します。（この場合11）
Setステートメントを使い、変数copyrngにセルG1の範囲を格納します。
Setステートメントを使い、変数myrngにセル(1,1)、セル(i,3)の範囲を格納します。（= A1:C11）
AdvancedFilterを使い、重複したレコードを無視して抽出・コピーし、指定先に貼り付けます。
プロシージャの記述を終了します。

AdvancedFilterを使って、A列の商品番号の重複を除いたデータを抽出し、B・C列と一緒にセルG1を基点に貼り付けます。
■AdvancedFilter
データリストから必要なデータを抽出します。Accessの抽出クエリのような使い方ができます。抽出結果は、選択範囲内に表示するか、ほかの範囲にデータをコピーするかを選択できます。選択された範囲が単一のセルのときは、そのアクティブセル領域が使われます。バリアント型の値を使用します。

オブジェクト.AdvancedFilter(Action, CriteriaRange,CopyToRange, Unique)

オブジェクト・・・必ず指定します。対象となるオブジェクトへの参照を返すオブジェクト式を指定します。
Action・・・必ず指定します。XlFilterAction クラスの定数を使用します。
　XlFilterAction クラスの定数
　　1、xlFilterCopy（抽出結果を他の範囲にデータをコピーする）
　　2、xlFilterInPlace（抽出結果を選択範囲内に表示する）
CriteriaRange・・・検索条件範囲を指定します。省略すると、検索条件なしで抽出されます。
CopyToRange・・・引数 Action を xlFilterCopy に設定したときは、抽出された行のコピー先のセル範囲を指定します。それ以外の場合、この引数は無視されます。
Uniqu・・・True に設定すると、検索条件に一致するレコードのうち、重複するレコードは無視されます。False に設定すると、重複するレコードも含めて、検索条件に一致するレコードがすべて抽出されます。既定値は False です。

※xlFilterCopyの例　（抽出結果を他の範囲にデータをコピーする）
■A4:E14の範囲にあるデータの中からA1:A2に指定された抽出条件で抽出されたデータをセルF1を基点にコピーします。

Sub Myadvance_01()
　　Range("A4:E14").AdvancedFilter xlFilterCopy, Range("A1:A2"), Range("F1"),Unique:=False
End Sub

※サンプルデータ

プロシージャMyadvance_01()を実行した結果↓

※xlFilterInPlaceの例（抽出結果を選択範囲内に表示する）
A4:E14の範囲にあるデータの中からA1:A2に指定された抽出条件でデータを今のリスト範囲内に抽出します。

Sub Myadvance_02()
　　Range("A4:E14").AdvancedFilter xlFilterInPlace, Range("A1:A2"), Unique:=False
End Sub

プロシージャMyadvance_02()を実行した結果↓

※非表示行を再表示するにはActivesheet.ShowAllData メソッドを使用します。（サンプルコード↓）

Sub myshow()
　ActiveSheet.ShowAllData
End Sub

■Sub 転記()を実行した結果

▲Top

3

数量（サブルーチン・3）

1
2

3
4
5
6
7

8
9

Sub 数量()
i = 0
j = 0
n = 0
Worksheets(1).Range("J1").Value = "数量"
j = Range("A65536").End(xlUp).Row
n = Range("G65536").End(xlUp).Row
For i = 2 To n
Cells(i, 10).Value = Application.WorksheetFunction.SumIf(Range(Cells(1, 1), Cells(j, 1)), _
Cells(i,7), Range(Cells(1, 4), Cells(j, 4)))
Next i
End Sub

1
2
3
4

5
6
7
8
9

数量という名のプロシージャを記述します。
変数 i ・j ・n をそれぞれ初期化します。
ワークシート1のセル(j ,1)に"数量"の文字を代入します
Endプロパティを使い最下行（A列65536行目）を基準として、そこからデータの入力されている上端のセルを参照しその、行番号を変数 j に代入します。（この場合11）
4と同じくG列の上端のセルを参照し、その行番号を変数nに代入します。（この場合6）
For ・・・Nextステートメントでカウンタ変数 i が2からn(この場合6)になるまで7の処理を繰り返します。
SumIf関数を使用して、Ｊ列[セル（i, 10）]に各商品の数量の合計を算出し代入します。
6に戻ります。
プロシージャの記述を終了します。

J列を集計列として、各商品の個数を集計します。通常こういった場合、エクセルの持つ集計機能、[データ]→[集計]をVBAから操作した結果の可視セルをコピーして貼り付ける方法もありますが、今回は、ワークシート関数を利用して集計します。
■ワークシート関数をVBAで使用するにはWorksheetFunction プロパティを利用します。
└→　　Application.WorksheetFunction.ワークシート関数名(引数)になります。

■SumIf関数（条件に当てはまるセルの値を合計します。）
SumIf(検索範囲,検索条件,合計範囲)
sub 数量()の場合、最初のCells(i,10).Value＝が計算した結果を代入するセルになります。（Ｊ列の2～6行目）
　　検索範囲は、Range(Cells(1, 1), Cells(j, 1))　→　セルA1:A11
　　検索条件は、Cells(i,7) → セルG2:G6
　　合計範囲は、Range(Cells(1, 4), Cells(j, 4)) → D1:D11 になります。
データ数が変動する場合は、行数などを変数に代入する必要がありますので、Cellsプロパティで設定しています。

■Sub 数量()を実行した結果

4

合計列（サブルーチン・4）

1
2

3
4
5
6
7
8

9

Sub 合計列()
i = 0
j = 0
n= 0
Worksheets(1).Range("K1").Value = "合計"
n = Range("G65536").End(xlUp).Row
For i = 2 To n
j = Cells(i, 9) * Cells(i, 10)
Cells(i, 11).Value = j
Next i

End Sub

1
2
3
4

5
6
7
8
9

合計列という名のプロシージャを記述します。
変数 i ・j ・n をそれぞれ初期化します。
ワークシート1のセル(K ,1)に"合計"の文字を代入します
Endプロパティを使い最下行（G列65536行目）を基準として、そこからデータの入力されている上端のセルを参照しその、行番号を変数 n に代入します。（この場合6）
For ・・・Nextステートメントでカウンタ変数 i が2からn(この場合6)になるまで6・7の処理を繰り返します。
変数 j に、セル（i ,9）とセル(i ,10)の値を掛けた値を代入します。
セル（i ,11）に変数 j の値を代入します。
5に戻ります。
プロシージャの記述を終了します。

K列にI列（単価）とJ列（数量）を掛けたものを、それぞれ代入します。

■Sub 合計列()を実行した結果

▲Top

5

列計（サブルーチン・5）

1
2

3
4
5
6
7
8

Sub 列計()
i = 0
n = 0
v = 0
i = Range("G65536").End(xlUp).Row
For Each v In Array(10, 11)
n = Application.WorksheetFunction.Sum(Range(Cells(2,v), Cells(i, v)))
Cells(i + 1, v).Value = n
Next v
End Sub

1
2
3

4
5

6

7
8

列計という名のプロシージャを記述します。
変数 i ・n ・v をそれぞれ初期化します。
Endプロパティを使い最下行（G列65536行目）を基準として、そこからデータの入力されている上端のセルを参照しその、行番号を変数 i に代入します。（この場合6）
For Each・・・Nextステートメントでオブジェクト変数vにArray関数に格納された値を元に5・6の処理を繰り返し実行します。
変数 nに、sum関数で求めた、セル（2,v）,（6,v）の縦計を代入します。
（v = 10と11なので、結果的にJ列とK列の縦計になります。）
セル（7,v）に5で求めた n の値を代入します。
（v = 10と11なので、結果的にセル（7,10）とセル（7,11）にnの値を代入する事になります。）
4に戻ります。
プロシージャの記述を終了します。

3と4で求めたJ列（数量）とK列（合計）の縦計を算出します。
この場合、WorksheetFunction プロパティを利用し、Ｊ列とＫ列の2行目から6行目をSUM関数で縦計を算出しています。
又、列番号を配列に格納して順番に処理させていますので、連続した列だけではなく、例えば10列目と12列目と15行目の縦計を求める、など自由に設定が可能です。

※配列を利用して簡単な集計をします。
（Array関数に格納された値をもとに、ワークシート関数のSum・Average・Countでそれぞれ値を算出します）

↑1行目から5行目までの計算結果を6行目に表示します。

Sub my関数()

Worksheets(1).Activate
Dim i As Integer
Dim v As Variant 'Array関数を使用する場合は、配列のデータ型をVariantにします。

i = Range("A65536").End(xlUp).Row　この場合、i = 5 になります。（6行目に解が表示される前なので）

'A・C列＝Sum関数(連続した範囲の合計を求める)
For Each v In Array(1, 3)　
n = Application.WorksheetFunction.Sum(Range(Cells(1, v), Cells(i, v)))
Cells(i + 1, v).Value = n
Next v

'B・E列＝Average関数（範囲内の平均を求める）
For Each v In Array(2, 5)　
n = Application.WorksheetFunction.Average(Range(Cells(1, v), Cells(i, v)))
Cells(i + 1, v).Value = n
Next v

'D・F列＝Count関数（数値データのセルを数える）
For Each v In Array(4, 6)　
n = Application.WorksheetFunction.Count(Range(Cells(1, v), Cells(i, v)))
Cells(i + 1, v).Value = n
Next v

End Sub

■Sub 列計()を実行した結果

6

書式（サブルーチン・6）　最後の仕上げとして、罫線、セルの配色などの書式設定をします。

Sub 書式()
Range("G1").CurrentRegion.SpecialCells(xlCellTypeConstants, xlNumbers).Select
　Selection.NumberFormatLocal = "#,##0;[赤]#,##0"
'↑セルG1を含むアクティブセル領域で、SpecialCellsメソッドを使い、
'数値が入力されているセルの表示形式を設定します。（I・J・K列の数字項目）
'この場合、「桁区切り有り」と「負の数の場合は赤色」に設定しました。

Range("G1").CurrentRegion.Cut Destination:=Range("G2")
'↑セルG1を含むアクティブセル領域を選択し、[切り取り]→[セルG2へ貼り付け]します。
'結果的に1行下げたことになります。

Range("G2").CurrentRegion.Select
　Selection.BorderAround LineStyle:=xlContinuous, _
　Weight:=xlMedium, ColorIndex:=55
'↑セルG2を含むアクティブセル領域を選択し、罫線を設定します。
'この場合、外周が中太実線（xlMedium）で色が紺色（ColorIndex:=55）になります。

With Selection.Borders(xlInsideVertical)
　　.LineStyle = xlContinuous
　　.Weight = xlThin
End With
'↑先ほどのアクティブセル領域の内側の縦線(xlInsideVertical)を細(xlThin)実線(xlContinuous)で設定します。

With Selection.Borders(xlInsideHorizontal)
　　.LineStyle = xlContinuous
　　.Weight = xlHairline
End With
'↑同様に内側の横線(xlInsideHorizontal)を極細(xlHairline)実線(xlContinuous)で設定します。

Range("G2:K2").Select
With Selection.Borders(xlEdgeBottom)
　　.LineStyle = xlContinuous
　　.Weight = xlThin
End With
'↑項目行の下端（xlEdgeBottom）の横線（2行目と3行目の間）を細（xlThin）実線（xlContinuous）に設定します。

i = 0
i = Range("K65536").End(xlUp).Row
Range(Cells(i, 7), Cells(i, 11)).Select
With Selection.Borders(xlEdgeTop)
　　.LineStyle = xlContinuous
　　.Weight = xlThin
End With
'↑合計欄の上端（7行目と8行目の間）の横線（xlEdgeTop）を細（xlThin）実線（xlContinuous）に設定します。

Range("G2:K2").Select
　With Selection
　　.HorizontalAlignment = xlCenter
　　.Interior.ColorIndex = 36
　　.Font.ColorIndex = 53
End With
'↑項目行（2行目）の横位置を中央揃え（HorizontalAlignment = xlCenter）に、
'バックを薄黄色（.Interior.ColorIndex = 36）に、文字色を茶色（.Font.ColorIndex = 53）にそれぞれ設定しています。

Range("G1:I1").Select
　With Selection
　　.MergeCells = True
　　.HorizontalAlignment = xlLeft
　　.Value = Range("E2")
　　.NumberFormatLocal = "yyyy年m月d日（aaa）売上"
　　.Font.Bold = True
　　.Font.ColorIndex = 55
End With
'↑タイトル行の3列（Ｇ1・Ｈ1・I1）を結合し（MergeCells = True）、横位置を左詰めにします。（HorizontalAlignment = xlLeft）
'セルE2から日付のデータを代入し、（この場合2008/5/12）
'年月日（曜）形式に書式を設定します。（NumberFormatLocal = "yyyy年m月d日（aaa）売上"）
'書体は太字（Font.Bold = True）、色は紺色（.Font.ColorIndex = 55）になります。

End Sub

セルG1：Ｋ8の範囲で完成した表の見栄えを整えます。最初はマクロの自動記録→ [ツール]→[マクロ]→[新しいマクロの記録]で記録して、そのプロシージャがどの様に対応しているかを色々試して、見やすい表を作成しましょう。

■Sub 書式()を実行した結果

※（参考）カラーパレットのインデックス番号

Sub mycolorindex()　'↑上のカラーパレット表の元となるプロシージャです。※Sheet1に展開

Dim i As Integer, j As Integer

Worksheets(1).Activate
For i = 1 To 14 Step 2
Cells(1, i).Select
Selection.ColumnWidth = 3
Do Until ActiveCell.Row = 9
ActiveCell.Value = ActiveCell.Row + j
ActiveCell.Offset(, 1).Interior.colorindex = ActiveCell.Value
ActiveCell.Offset(1).Select
Loop
j = ActiveCell.Offset(-1).Value
Next

End Sub

▲Top