(1)マスタープログラム
マスタープログラムの目的
・更新作業に使われます。
請求書を例にとれば当月請求金額が翌月になると前月請求金額にかわります。
在庫であれば当月在庫数が前月在庫数に変わります。
更新すると金額・数量が消えてしまいますので、消えないようにする工夫が必要です。
・伝票入力支援に使われます。
得意先名を入力するのにコード番号のみで入力できるようにするためのシートです。
・分析データの項目に使われます。
マスターファイルに項目を追加するだけでトランザクション(取引累積)ファイルから追加した項目でデータ分析ができます。
リレーション機能
(a)得意先
フォームを使って登録します。
フォームのオブジェクト名です。
フォームが開くときに実行するプロシージャです。
・得意先コード番号を連番で最終番号+1を取得しています。
Worksheets("得意先").Cells(lastrow, 1) + 1
・コンボボックスに商品区分一覧を表示しています。
Private Sub UserForm_Initialize()
Dim i As Long
Dim lastrow As Long
lastrow = Worksheets("得意先").Cells(Rows.Count, 1).End(xlUp).Row
lblCodeno.Caption = Worksheets("得意先").Cells(lastrow, 1) + 1
lastrow = Worksheets("得意先区分").Cells(Rows.Count, 1).End(xlUp).Row
With cmbKubun
.ColumnCount = 2 '表示列数の設定
.TextColumn = 2 '表示列の設定
End With
For i = 2 To lastrow
With cmbKubun
.AddItem
.List(i - 2, 0) = Worksheets("得意先区分").Cells(i, 1)
.List(i - 2, 1) = Worksheets("得意先区分").Cells(i, 2)
End With
Next
End Sub
該当する得意先区分をクリックしたとき得意先コード番号をラベルに貼り付けています。
Private Sub cmbKubun_Click()
lblTkucode.Caption = cmbKubun.List(cmbKubun.ListIndex, 0)
End Sub
最後の行の次空白行に入力したデータをコピーしています。
Private Sub cmdTouroku_Click()
Dim lastrow As Long
lastrow = Worksheets("得意先").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("得意先").Cells(lastrow + 1, 1) = lblCodeno.Caption
Worksheets("得意先").Cells(lastrow + 1, 2) = txtTname.Text
Worksheets("得意先").Cells(lastrow + 1, 3) = txtYubin.Text
Worksheets("得意先").Cells(lastrow + 1, 4) = txtAdd.Text
Worksheets("得意先").Cells(lastrow + 1, 5) = lblTkucode.Caption
Worksheets("得意先").Cells(lastrow + 1, 6) = cmbKubun.Text
Worksheets("得意先").Cells(lastrow + 1, 7) = txtKisyu.Text
Unload Me
End Sub
キャンセルボタンをクリックした時の処理
Private Sub cmdCancel_Click()
Unload Me
End Sub
ボタンから実行できるようにフォームの開くを標準モジュールに書いています
Sub 得意先()
frmTokui.Show
End Sub
(b)商品
フォームを使って登録します。
フォームのオブジェクト名です。
フォームが開くときに実行するプロシージャです。
・商品コード番号を連番で最終番号+1を取得しています。
Worksheets("商品名").Cells(lastrow, 1) + 1
・コンボボックスに商品区分一覧を表示しています。
Private Sub UserForm_Initialize()
Dim i As Long
Dim lastrow As Long
lastrow = Worksheets("商品名").Cells(Rows.Count, 1).End(xlUp).Row
lblCodeno.Caption = Worksheets("商品名").Cells(lastrow, 1) + 1
lastrow = Worksheets("商品区分").Cells(Rows.Count, 1).End(xlUp).Row
With cmbKubun
.ColumnCount = 2 '表示列数の設定
.TextColumn = 2 '表示列の設定
End With
For i = 2 To lastrow
With cmbKubun
.AddItem
.List(i - 2, 0) = Worksheets("商品区分").Cells(i, 1)
.List(i - 2, 1) = Worksheets("商品区分").Cells(i, 2)
End With
Next
End Sub
該当する商品区分をクリックしたとき商品コード番号をラベルに貼り付けています。
Private Sub cmbKubun_Click()
lblSkucode.Caption = cmbKubun.List(cmbKubun.ListIndex, 0)
End Sub
最後の行の次空白行に入力したデータをコピーしています。
Private Sub cmdTouroku_Click()
Dim lastrow As Long
lastrow = Worksheets("商品名").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("商品名").Cells(lastrow + 1, 1) = lblCodeno.Caption
Worksheets("商品名").Cells(lastrow + 1, 2) = txtSname.Text
Worksheets("商品名").Cells(lastrow + 1, 3) = lblSkucode.Caption
Worksheets("商品名").Cells(lastrow + 1, 4) = cmbKubun.Text
Worksheets("商品名").Cells(lastrow + 1, 5) = txtStanka.Text
Worksheets("商品名").Cells(lastrow + 1, 6) = txtHtanka.Text
Unload Me
End Sub
キャンセルボタンをクリックした時の処理
Private Sub cmdCancel_Click()
Unload Me
End Sub
ボタンから実行できるようにフォームの開くを標準モジュールに書いています
(c)得意先区分
Sub 商品()
frmSyouhin.Show
End Sub
得意先区分の入力・照会・訂正・削除はエクセルの機能を使ってシートを操作すれば十分です。
Sub 得意先区分()
Worksheets("得意先区分").Select
End Sub
一度に得意先区分名を変更するプログラム
得意先を直接、得意先シートから入力した場合また得意先区分名が変更になった場合
一度に得意先区分名を変更するプログラムです。
得意先の繰り返しの中に得意先区分の繰り返しがありその中で得意先の区分コードと得意先区分の区分コードを条件文(IF文)で判断する流れです。
Sub 得意先区分名移行()
Dim i As Long
Dim j As Long
Dim lastrow As Long
Dim lastrow1 As Long
lastrow = Worksheets("得意先").Cells(Rows.Count, 1).End(xlUp).Row
lastrow1 = Worksheets("得意先区分").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
For j = 2 To lastrow1
If Cells(i, 5) = Worksheets("得意先区分").Cells(j, 1) Then
Cells(i, 6) = Worksheets("得意先区分").Cells(j, 2)
Exit For
End If
Next
Next
End Sub
(d)商品区分
商品区分の入力・照会・訂正・削除はエクセルの機能を使ってシートを操作すれば十分です。
Sub 商品区分()
Worksheets("商品区分").Select
End Sub
一度に商品区分名を変更するプログラム
商品を直接、商品名シートから入力した場合また商品区分名が変更になった場合
一度に商品区分名を変更するプログラムです。
商品名の繰り返しの中に商品区分の繰り返しがありその中で商品名の区分コードと商品区分の区分コードを条件文(IF文)で判断する流れです。
Sub 商品区分名移行()
Dim i As Long
Dim j As Long
Dim lastrow As Long
Dim lastrow1 As Long
lastrow = Worksheets("商品名").Cells(Rows.Count, 1).End(xlUp).Row
lastrow1 = Worksheets("商品区分").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrow
For j = 2 To lastrow1
If Cells(i, 3) = Worksheets("商品区分").Cells(j, 1) Then
Cells(i, 4) = Worksheets("商品区分").Cells(j, 2)
Exit For
End If
Next
Next
End Sub