もどる

 Top5プログラム
HOMEへ
PRODUCTSへ
LEARNING
LINKへ
LOGO
HeadLine
ORDER FORMへ
Image画像
MailTo:

もどる


(c) Copyright 2005 VBAを基礎から解説 VBA World All rights reserved.
E-Mail:info@vba-world.com

 ここで紹介するのは、ゲームなどでありがちな過去の高得点者のデータから上位5個分の得点をを表示して保存しておく、というものです。保存先は、もちろん Excelシートです。

  「Top10」でも良いのですが、「Top5」を作っておけば応用は簡単ですので、今回は「Top5プログラム」を紹介します。
フォーム

 例として次のようなフォームを作成する。

コントロール名 用途 オブジェクト名 数量
テキストボックス 今回分 得点入力用 TextBox1
ラベル 保存得点表示用 Label1〜Label5
ボタン Top5への入れ込み用 CommandButton1
シートへのデータ保存用 CommandButton2

フォーム:Top5.xls
初期データの読み込み

 フォームが表示されるときに発生するイベントを利用して、前回保存データをフォームに読み込む。

1.イベントの設定

  プログラム入力ウィンドウの上部、左側のプルダウン・メニューから「 UserForm 」を
 選択する。


 次のようにイベント・プロシージャが表示されるが無視して次に進む。


 右側のプルダウンメニューから「 Initialize 」を選択する。


 これで、UserForm_Initialize プロシージャが出来る。

 ここで、Private Sub UserForm_Click() から End Sub は削除(消去)してかまわない。

 次のようにプログラムを入力する。


Private Sub UserForm_Initialize()

 Me.Label1.Caption = Format(Sheets("Sheet1").Range("A1"), "#,###")
 Me.Label2.Caption = Format(Sheets("Sheet1").Range("A2"), "#,###")
 Me.Label3.Caption = Format(Sheets("Sheet1").Range("A3"), "#,###")
 Me.Label4.Caption = Format(Sheets("Sheet1").Range("A4"), "#,###")
 Me.Label5.Caption = Format(Sheets("Sheet1").Range("A5"), "#,###")

End Sub


データを入れ込む

 プログラム入力ウィンドウの上部左側のプルダウン・メニューから「 CommandButton1 」を選択する。


 これで、CommandButton1_Clikc プロシージャが出来る。


 次のようにプログラムを入力する。


Option Explicit

Private Sub CommandButton1_Click()
 Dim strS As String

 If Val(Replace(Me.Label1.Caption, ",", "")) _
               < Val(Me.TextBox1.Value) Then
  strS = Val(Replace(Me.Label1.Caption, ",", ""))
  Me.Label1.Caption = Format(Me.TextBox1.Value, "#,###")
  Me.TextBox1.Value = strS
 End If

 If Val(Replace(Me.Label2.Caption, ",", "")) _
               < Val(Me.TextBox1.Value) Then
  strS = Val(Replace(Me.Label2.Caption, ",", ""))
  Me.Label2.Caption = Format(Me.TextBox1.Value, "#,###")
  Me.TextBox1.Value = strS
 End If

 If Val(Replace(Me.Label3.Caption, ",", "")) _
               < Val(Me.TextBox1.Value) Then
  strS = Val(Replace(Me.Label3.Caption, ",", ""))
  Me.Label3.Caption = Format(Me.TextBox1.Value, "#,###")
  Me.TextBox1.Value = strS
 End If

 If Val(Replace(Me.Label4.Caption, ",", "")) _
               < Val(Me.TextBox1.Value) Then
  strS = Val(Replace(Me.Label4.Caption, ",", ""))
  Me.Label4.Caption = Format(Me.TextBox1.Value, "#,###")
  Me.TextBox1.Value = strS
 End If

 If Val(Replace(Me.Label5.Caption, ",", "")) _
               < Val(Me.TextBox1.Value) Then
  strS = Val(Replace(Me.Label5.Caption, ",", ""))
  Me.Label5.Caption = Format(Me.TextBox1.Value, "#,###")
  Me.TextBox1.Value = strS
 End If

 Me.TextBox1.Value = ""

End Sub


 これで、入力した値との比較が完了し Top5が完成する。
データを書き出す

 プログラム入力ウィンドウの上部左側のプルダウン・メニューから「 CommandButton2 」を選択する。


 これで、CommandButton2_Clikc プロシージャが出来る。


 次のようにプログラムを入力する。


Private Sub CommandButton2_Click()

 Sheets("Sheet1").Range("A1") = Replace(Me.Label1.Caption, ",", "")
 Sheets("Sheet1").Range("A2") = Replace(Me.Label2.Caption, ",", "")
 Sheets("Sheet1").Range("A3") = Replace(Me.Label3.Caption, ",", "")
 Sheets("Sheet1").Range("A4") = Replace(Me.Label4.Caption, ",", "")
 Sheets("Sheet1").Range("A5") = Replace(Me.Label5.Caption, ",", "")
 Unload Me

End Sub



プログラム別解

 上記したプログラムは構成を考慮しないプログラムなので、次のような内容でメンテナンス性に欠ける。
  • ダブって処理される部分が多い
  • プログラム中の変数を使用していない
 以上を考慮してプログラムしたのが次のコードである。このようにプログラムすることをお勧めする。


Option Explicit

Dim lngData(5) As Long
Dim ctlLabel(5) As Control


Private Sub UserForm_Initialize()
 Dim i As Integer

 Set ctlLabel(1) = Me.Label1
 Set ctlLabel(2) = Me.Label2
 Set ctlLabel(3) = Me.Label3
 Set ctlLabel(4) = Me.Label4
 Set ctlLabel(5) = Me.Label5

 For i = 1 To 5
  lngData(i) = Sheets("Sheet1").Range("A" & i)
 Next i

 DataDisp

End Sub


Private Sub CommandButton1_Click()
 Dim lngNewData As Long
 Dim i As Integer

 lngNewData = Val(Me.TextBox1.Value)

 For i = 1 To 5
  DataCheck lngData(i), lngNewData
 Next i

 DataDisp
 Me.TextBox1.Value = ""
 Me.TextBox1.SetFocus

End Sub


Private Sub DataCheck(lngData As Long, lngNewData As Long)
 Dim lngDummy As Long

 If lngNewData > lngData Then
  lngDummy = lngNewData
  lngNewData = lngData
  lngData = lngDummy
 End If

End Sub


Private Sub DataDisp()
 Dim i As Integer

 For i = 1 To 5
  ctlLabel(i).Caption = Format(lngData(i), "#,###")
 Next i

End Sub


Private Sub CommandButton2_Click()
 Dim i As Integer

 For i = 1 To 5
  Sheets("Sheet1").Range("A" & i) = lngData(i)
 Next i

 Unload Me

End Sub