はじめに
ExcelのVBAに関していえば、文法的なことを説明するための問題が多いが、ここでは初めに課題、事例を提示して、マクロプログラミングを行うことで必要なことを解説していく。
引用／参考文献は
である。
問題１
目標とするデータと入力の形
問題のデータと入力画面
| D | 商品名 | 原価 |
| 1595-4615 | 【ミニカー】メルセデスベンツ300SL | 24,500 |
| 商品ID | 商品名 | 原価 |
| 1156-2510 | 【鉄道模型】ななつ星8両セット | 98,500 |
| 1156-2511 | 【鉄道模型】キハ56系急行編成3両セット | 328,000 |
| 1156-2512 | 【鉄道模型】スーパーあずさ8両セット | 715,000 |
| 1595-4612 | 【ミニカー】ジャガーEタイプ | 55,700 |
| 1595-4613 | 【ミニカー】ロールスロイス ゴースト | 69,200 |
| 1595-4614 | 【ミニカー】ポルシェ904GTS | 56,900 |
| 2094-7822 | 【プラモデル】宇宙戦艦ヤマト | 49,800 |
| 2094-7823 | 【プラモデル】銀河鉄道999ミニカコレ777 | 12,500 |
上記のデータに対して、上の2行目のデータを表の最終行に追加するプログラムを作成せよ。ただし、マクロをキックさせるときは、セルに埋め込んだコマンドボタンをつかうこと。
解答
セルにコマンドボタンを登録する方法は、ユーザーフォームpart1を見て欲しい。
コード
Option Explicit
Option Base 1
Public lrn As Integer, lcn As Integer
ーーーーーーーーーーーーーーーーーーーーーーー
Sub main()
Call lastRowNum
Call lastClmnNum
Call inpData
Call delData
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
Sub lastRowNum()
lrn = Cells(Rows.Count, 1).End(xlUp).Row
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
Sub lastClmnNum()
lcn = Cells(1, Columns.Count).End(xlToLeft).Column
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
Sub inpData()
Cells(lrn + 1, 1).Value = Cells(2, 1).Value
Cells(lrn + 1, 2).Value = Cells(2, 2).Value
Cells(lrn + 1, 3).Value = Cells(2, 3).Value
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
Sub delData()
Range(Cells(2, 1), Cells(2, 3)).ClearContents
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
これは広域変数とサブルーチンの練習として取り上げた。
コード自体に特に説明を有するものはないだろう。ただ、サブルーチンのlastClmnNumは作っただけで使用はしていない。
セルのコマンドボタンにはmainを登録して使用する。以下、基本的にコマンドボタンに割り付けるルーチンはmainとなる。
また、本来はこのような入力情報に対しては、ユーザーフォームを使う方がいい.。最後にユーザーフォームを使ったプログラムを紹介する。
問題2
目標とする形とデータ
データ
| 仕入日 | 商品 | 数量 |
| 6/6 | 蛍光ペン | 7 |
| 6/7 | 蛍光ペン | 28 |
| 6/8 | 蛍光ペン | 19 |
| 6/9 | 蛍光ペン | 3 |
| 6/10 | 蛍光ペン | 19 |
| 6/6 | ホッチキス | 12 |
| 6/7 | ホッチキス | 6 |
| 6/8 | ホッチキス | 11 |
| 6/9 | ホッチキス | 23 |
| 6/10 | ホッチキス | 5 |
| 日付 商品 |
6/6 | 6/7 | 6/8 | 6/9 | 6/10 |
| 蛍光ペン | |||||
| ホッチキス |
上記のデータ表を下記の表に転記するとき、
１）For Next文とIf文のみで記述せよ。
２）For Each文とFor NextとIf文で記述せよ。
ここでは表を上下に書いたが、実際は上の表の横に下の表が書いてある。目標の図を参照のこと。
解答
いまどき、リスト形式の表をクロス集計するプログラムは古臭い。ピボットテーブルを使えばことが足りる。また、クロス集計からリスト形式にするにはパワークエリを使えば簡単に変換することができる。
ここでの狙いは2通りの繰り返し処理と分岐処理をマスターすることである。
１）コード
Option Explicit
Option Base 1
Dim grd As Integer, gcd As Integer, gnr As Integer
ーーーーーーーーーーーーーーーーーーーーーーー
Sub main()
Call getListDt
Call compareDt
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
Sub getListDt()
grd = Cells(Rows.Count, 1).End(xlUp).Row
gcd = Cells(1, Columns.Count).End(xlToLeft).Column
gnr = Cells(Rows.Count, 7).End(xlUp).Row
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
Sub compareDt()
Dim i As Integer, j As Integer, k As Integer
For i = 2 To grd
For j = 8 To gcd
For k = 2 To gnr
If Cells(i, 1) = Cells(1, j) And Cells(i, 2) = Cells(k, 7) Then
Cells(k, j) = Cells(i, 3)
End If
Next k
Next j
Next i
ActiveWorkbook.Save
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
grdは元表の最終行をとっている。gcdとgnrは転記する表の最終の列数と行数をとっている。
If文のなかのandは元表と転記先の2つが一致したら、という意味である。
２）コード
Option Explicit
Option Base 1
Public gdt As Variant
ーーーーーーーーーーーーーーーーーーーーーーー
Sub main()
Call getDataTable
Call inpNewTable
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
Sub getDataTable()
gdt = Range("A1").CurrentRegion
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
Sub inpNewTable()
Dim i As Integer
Dim dys As Date
Dim gds As String
Dim rng As Range
For Each rng In Range("H2:L3")
dys = Cells(1, rng.Column).Value
gds = Cells(rng.Row, 7).Value
For i = 2 To 11
If dys = gdt(i, 1) And gds = gdt(i, 2) Then
rng.Value = gdt(i, 3)
End If
Next i
Next rng
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
広域変数でgdtをバリアント型で取っている。バリアント型は使わないのが定石だと、かなり多くの本やブログなどで書いてあるが、様々な型、たとえば日付のDate、文字列のString、数値のIntegerなどが混在している場合には、バリアント型を使うしか手はない。
使わないのが定石ではなく、定石なのは型を明示することである。
また、型でRangeを使った場合、SetステートメントでRangeを規定してやらなければならないのだが、例外的にFor Each文で使う場合は、Setステートメントは必要ない。
問題1のユーザーフォーム版
ユーザーフォームpart2でラベル、テキストボックス、コマンドボタンの説明はしてあるので、細かいことは、そちらを参照して欲しい。
ここでは、コードを紹介するのみで十分だと思う。
標準モジュールのコード
Option Explicit
Option Base 1
Public lrn As Integer
ーーーーーーーーーーーーーーーーーーーーーーー
Sub main()
UserForm1.Show
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
Sub lastRowNum()
lrn = Cells(Rows.Count, 1).End(xlUp).Row
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
ユーザーフォームのコード
Option Explicit
Option Base 1
ーーーーーーーーーーーーーーーーーーーーーーー
Private Sub UserForm_Initialize()
Call lastRowNum
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
Private Sub CommandButton1_Click()
ActiveWorkbook.Save
Call lastRowNum
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
Private Sub TextBox1_Change()
Cells(lrn + 1, 1) = TextBox1.Text
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
Private Sub TextBox2_Change()
Cells(lrn + 1, 2) = TextBox2.Value
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
Private Sub TextBox3_Change()
Cells(lrn + 1, 3) = TextBox3.Value
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
サイトご利用方法
次のページ・前のページを利用するよりも、グローバルメニュー（ヘッダー部分にある項目）・サブメニュー記事の項目をクリックしていただければ、その項目の全体像が一目でみることができ、クリックすればそのサイトへ飛びます。
google、yahoo、Bingなどで検索する場合、検索ワードは先頭に、孤立じじい、と入力しその後に、グローバルメニュー・サブメニュー記事のどれかひとつの項目を入力すると、その検索サイトが上位表示されます。