SCHOOL OF VBA　そのあとに　その２

2020年3月3日 2020年3月3日

Naoki Kikkawa

SCHOOL OF VBA　そのあとに　その２

こんにちは。伊川(@naonaoke)です。

SCHOOL OF VBAのそのあとに　その１

2020.2.22

VBAを使う考え方　その1 こんにちは。伊川(@naonaoke)です。今回は、SCHOOL　OF　VBAの知識をどのように使うのかを解説していきます。コラボ指数という数値をT...

今回はこの記事の続きになります。

前回は、フリーソフトに取込むための下準備をしました。

今回は、CSVファイル手前までを解説します。

その前に、動画では、説明が上手くできなくて、申し訳ありません。

動画はここをクリック

ActivecellをRangeで指定する。

東京をRange(“D1”)に変更しました。

では、この東京をどのように入力するのか？

必要な情報は、基本、お客様に入力してもらう。

Excelを起動すると、ユーザーフォームが起動するようになっています。

ユーザーフォームをExcel起動時に表示するコード

Sub Auto_open()
UserForm1.Show
End Sub

Sub Auto_open()

UserForm1.Show

End Sub

競馬場を選択しないとレースIDを作成することができません。

つまり、お客様は必ず競馬場を選択します。

もし選択をしなかった場合は先に進むことができないように仕掛けをします。

ACCESS　検索フォームの作り方　その4　入力ミスを撲滅

2019.11.16

データベースの最大の敵を攻略せよこんにちは。伊川(@naonaoke)です。今回は、データベースの最大の敵である、入力漏れを撲滅する技を紹介します。入力漏れがあると、データベ...

この記事を参考にしてください。

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 = "@"

'----------------------------正しい数値が入力されないと実行させない----------

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構文で記載しました。

SCHOOL　OF　VBA　第七回　Withステートメント

2020.1.25

第七回目　SCHOOL　OF　VBA　講義内容こんにちは。伊川(@naonaoke)です。今回は、Withステートメントを紹介します。 Withステートメントは、非常に便利な機...

コラボ指数を転記する

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

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

'---------------------------レース番号転記----------------------------

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

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

この記事を書いた人

Naoki Kikkawa

KEIYU企画代表の吉川　直希と申します。Excel　ACCESSについて、伊川　直助という名前で、YouTubeで動画を配信しています。皆様の職場で、もっと、Excelや、ACCESSを使えたら、業務が早くなるということがありせんか？私は、職場で、大量のデータを7年くらい扱い、社内で自らシステムを開発して、業務時間を短縮してきました。お困りの方はぜひ私に連絡をください。