目次
SCHOOL OF VBA そのあとに その２
こんにちは。伊川(@naonaoke)です。
今回はこの記事の続きになります。
前回は、フリーソフトに取込むための下準備をしました。
今回は、CSVファイル手前までを解説します。
その前に、動画では、説明が上手くできなくて、申し訳ありません。
ActivecellをRangeで指定する。
東京をRange(“D1”)に変更しました。
では、この東京をどのように入力するのか？
必要な情報は、基本、お客様に入力してもらう。
Excelを起動すると、ユーザーフォームが起動するようになっています。
ユーザーフォームをExcel起動時に表示するコード
Sub Auto_open() UserForm1.Show End Sub
競馬場を選択しないとレースIDを作成することができません。
つまり、お客様は必ず競馬場を選択します。
もし選択をしなかった場合は先に進むことができないように仕掛けをします。
この記事を参考にしてください。
ACCESSでも、Excelでも、入力漏れがあった場合は、必ず、誰かが、リカバリをしなければなりません。
責任をもって、一番初めて入力する人が、完璧に入力するれば、いいのです。
できなければ、させるのです。
作成者は、エンドユーザーを信用してはいけません。
この入力漏れのコードを知っているだけで、かなりの時間が節約できます。
'----------------------------正しい数値が入力されないと実行させない----------
If Len(TextBox1) <> 4 Then
MsgBox "年月日は4文字です。"
Cancel = True
Exit Sub
End If
If Len(TextBox2) <> 2 Then
MsgBox "月は2文字です。"
Cancel = True
Exit Sub
End If
If Len(TextBox3) <> 2 Then
MsgBox "日は2文字です。"
Cancel = True
Exit Sub
End If
If Len(ComboBox1) <> 2 Then
MsgBox "競馬場は2文字です。"
Cancel = True
Exit Sub
End If
If Len(TextBox4) <> 2 Then
MsgBox "回次は2文字です。"
Cancel = True
Exit Sub
End If
If Len(TextBox5) <> 2 Then
MsgBox "日次は2文字です。"
Cancel = True
Exit Sub
End If
'----------------------------------------Sheet2のA列～C列を文字列に変更----------------
Worksheets(1).Select
'---------Unicode テキストでセルA1から貼り付ける----------
Range("A1").Select
ActiveSheet.PasteSpecial Format:="Unicode テキスト", Link:=False, _
DisplayAsIcon:=False
Range("A:B").Insert
Worksheets(2).Range("A:C").NumberFormatLocal = "@"
このコードを利用することで、Range(“D1”)には、必ず競馬場が入力される仕掛けになっています。
セルに入力できる数字は、15桁の制限がある
Microsoft Excel では、セルに 15 桁を超える数字を入力すると、15 桁目より下位のすべての桁がゼロに変更されます。
JRAが作為的に16桁以上の数字を使っているとしか思えませんでした。
16桁以上の数字を表示させるには、セルをあらかじめ、文字列に変更しなければなりません。
Worksheets(2).Range(“A:C”).NumberFormatLocal = “@”
レースIDを作成する
前回のブログで紹介しましたが、上の図がレースIDの構成です。
レース番号と、ゼッケン番号以外は、ユーザーフォームで作成できます。
TextBox2⇒月
TextBox3⇒日
ComboBox1⇒馬場コード（競馬場に応じて変化）
TextBox4⇒回次
TextBox5⇒日次
もっとカンタンな書き方もあると思いますが、WithステートメントとIF構文で記載しました。
コラボ指数を転記する
Worksheets(1).Range(“D1”) = ComboBox1 & “1R”
このようにして、メルクマールとなる文字を作成します。
東京と、東京が一致したら、指数を転記する。
なぜこんな面倒なことをするのかというと、一年で、11Rしかない日があるからです。
競馬をしない人はわからないと思いますが、一緒くたに12Rにしてしますと、
まったく違う競馬場の指数を転記する可能性があるからです。
コードなのですが12R分を記載しました。
ループできませんでした。
Dim ws2 As Object
Set ws2 = Worksheets("Sheet2")
Dim ws As Object
Set ws = Worksheets("Sheet1")
With ActiveCell
If Range("C1") = .Offset(0, -2) Then
Range(.Offset(3, 1), .Offset(3, 18)).Copy ws2.Cells(2, 4)
ws.Select
End If
If Range("C1") = .Offset(5, -2) Then
Range(.Offset(8, 1), .Offset(8, 18)).Copy ws2.Cells(3, 4)
ws.Select
End If
If Range("C1") = .Offset(10, -2) Then
Range(.Offset(13, 1), .Offset(13, 18)).Copy ws2.Cells(4, 4)
ws.Select
End If
If Range("C1") = .Offset(15, -2) Then
Range(.Offset(18, 1), .Offset(18, 18)).Copy ws2.Cells(5, 4)
ws.Select
End If
If Range("C1") = .Offset(20, -2) Then
Range(.Offset(23, 1), .Offset(23, 18)).Copy ws2.Cells(6, 4)
ws.Select
End If
If Range("C1") = .Offset(25, -2) Then
Range(.Offset(28, 1), .Offset(28, 18)).Copy ws2.Cells(7, 4)
ws.Select
End If
If Range("C1") = .Offset(30, -2) Then
Range(.Offset(33, 1), .Offset(33, 18)).Copy ws2.Cells(8, 4)
ws.Select
End If
If Range("C1") = .Offset(35, -2) Then
Range(.Offset(38, 1), .Offset(38, 18)).Copy ws2.Cells(9, 4)
ws.Select
End If
If Range("C1") = .Offset(40, -2) Then
Range(.Offset(43, 1), .Offset(43, 18)).Copy ws2.Cells(10, 4)
ws.Select
End If
If Range("C1") = .Offset(45, -2) Then
Range(.Offset(48, 1), .Offset(48, 18)).Copy ws2.Cells(11, 4)
ws.Select
End If
If Range("C1") = .Offset(50, -2) Then
Range(.Offset(53, 1), .Offset(53, 18)).Copy ws2.Cells(12, 4)
ws.Select
End If
If Range("C1") = .Offset(55, -2) Then
Range(.Offset(58, 1), .Offset(58, 18)).Copy ws2.Cells(13, 4)
ws.Select
End If
End With
レース番号を転記する
ActiveCellは、Cells(41,3)です。
ActiveCell.Rowは、41を表します。
このActivecell.Row(41)から5個飛ばしで、ループさせます。
このコードの書き方は非常に重要です。
5個飛ばしで取得した値を、WorkSheet2へ転記します。
'---------------------------レース番号転記----------------------------
Dim j As Long
Cut = 1
For j = ActiveCell.Row To ActiveCell.Row + 56 Step 5
Cut = Cut + 1
ws2.Cells(Cut, 2) = ws.Cells(j, 2)
Next j
'---------------------------------------------------------------------
Dim race As Long
For race = 2 To 13
ws2.Cells(race, 3) = ws2.Cells(race, 1) & ws2.Cells(race, 2)
Next race
End Sub
まとめ
次回は、自動でCSVファイルに加工してデスクトップに保存する方法を紹介します。
説明が下手くそで申し訳ありません。
