SCHOOL OF VBA そのあとに その2

B!

 

目次

SCHOOL OF VBA そのあとに その2

こんにちは。伊川(@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の構成です。


レース番号と、ゼッケン番号以外は、ユーザーフォームで作成できます。


レースID
TextBox1⇒西暦
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ファイルに加工してデスクトップに保存する方法を紹介します。

説明が下手くそで申し訳ありません。

 

最新の記事はこちらから