文鳥×ボートDIARY競艇のデータ収集（3）

VBAでレース実績をデータベース形式に編集！

はーいこんばんは(*'ω'*)
今週は4日しか働いてないのに…疲れた…。。。
でも、待ちにまった3連休！
の1日目が終わりそう...つらい。。。

前回の記事で、半年間のレーサー実績データをpythonで自動ダウンロードするお話をしまして。

pythonコード実装してダウンロードできたものの、中見てびっくり。
分析には使えそうもない文字羅列テキスト。
えー…。分析できない…。

(´;ω;｀)ﾀｽｹﾃ

データをよく確認すると、ほとんど規則的な文字列だったけど。
厄介な文字列さんがちらほら。
--------------------------------------------
■ 血液型
↑AB型の選手がいると後ろの文字列が１Byteずれる
■ 前回/前前回/前前前回選手グレード
↑若手の選手は前回グレードがないので２Byte以上ずれる
前回グレードはあるけど、前前回がないレーサーもいるし…。
--------------------------------------------

と、いうことは…。
パセリよりセロリより嫌いな。。。場合分け。

pythonで場合分けしてもよかったんだけど、VBAのほうが簡単なので。
ささっと作ってしまいます。

データ整理開始！

とりあえずやってみる。
前回ダウンロードしたテキストファイルをExcel上にインポート。

※1600行あるよ(´;ω;｀)

ちなみにこのデータは↓の情報のかたまりです。

https://www.boatrace.jp/owpc/pc/extra/data/layout.html

抜粋(*'ω'*)

では。
Column1には登録番号、選手名、ふりがな、登録支部、生年月日の情報。
選手ごとに分析したいから、まずは選手名だけを抜き出す。

はいできた。

VBA
-------------------------------------------------
Sub no1()
'①セルの中に半角カタカナが出てくるまでの文字を抜き出すマクロ
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim result As String

    Set ws = ThisWorkbook.Sheets("fan2410") '★対象のシート名を指定してね
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ws.Range("C1") = "torokubango"
    For i = 2 To lastRow
        result = GetTextBeforeKatakana(ws.Cells(i, 1).Value)
        ws.Cells(i, 3).Value = result
    Next i
'3列目に名前カナまでを抜き出した文字列生成ができました。
End Sub
-------------------------------------------------
Function GetTextBeforeKatakana(target As String) As String
    Dim i As Integer
    Dim result As String
    Dim katakanaStart As Boolean
    
'★Sub GetTextBeforeKatakanaForColumnA()と一緒に使うFunctionです★
    result = ""
    katakanaStart = False

    For i = 1 To Len(target)
        If AscW(Mid(target, i, 1)) >= &HFF61 And AscW(Mid(target, i, 1)) <= &HFF9F Then
            katakanaStart = True
            Exit For
        End If
        result = result & Mid(target, i, 1)
    Next i

    If katakanaStart Then
        GetTextBeforeKatakana = result
    Else
    End If
End Function

実行後はこんな感じ。

レーサーの名前に含まれるスペースを消して、登録番号とレーサーの名前セルも分割。ついでに登録支部とグレードの列も分ける。

VBA
-------------------------------------------------
Sub no2()
'②2列目と3列目各セルのスペースを削除するマクロ
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long

    Set ws = ThisWorkbook.Sheets("fan2410") '★対象のシート名を指定してください
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row

    For i = 2 To lastRow
        ws.Cells(i, 2).Value = Replace(ws.Cells(i, 2).Value, "　", "") '全角スペース削除
        ws.Cells(i, 2).Value = Replace(ws.Cells(i, 2).Value, " ", "")  '半角スペース削除
        ws.Cells(i, 3).Value = Replace(ws.Cells(i, 3).Value, "　", "") '全角スペース削除
    Next i
End Sub
-------------------------------------------------
Sub no3()
'③登録番号とレーサー名称を分離するマクロ
'3列目に登録番号、4列目にレーサー名称(漢字のみ)を記述します。
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim cellValue As String
    Dim firstPart As String
    Dim remainingPart As String

    Set ws = ThisWorkbook.Sheets("fan2410") '★対象のシート名を指定してください
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ws.Range("D1") = "racer"
    
    For i = 2 To lastRow
        cellValue = ws.Cells(i, 3).Value
        If Len(cellValue) > 4 Then
            firstPart = Left(cellValue, 4)
            remainingPart = Mid(cellValue, 5)
        Else
            firstPart = cellValue
            remainingPart = ""
        End If
        ws.Cells(i, 3).Value = firstPart
        ws.Cells(i, 4).Value = remainingPart
    Next i
End Sub
-------------------------------------------------
Sub no4()
'④階級と支部を取得するマクロ
'5列目に支部、6列目に階級を記述します。
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim cellValue As String
    Dim extractedChar As String

    Set ws = ThisWorkbook.Sheets("fan2410") '★対象のシート名を指定してください
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ws.Range("E1") = "shibu"
    ws.Range("F1") = "grade"
    
    For i = 2 To lastRow
        cellValue = ws.Cells(i, 1).Value
        If Len(cellValue) >= 5 Then
            ' 右側から4文字取り出し
            cellValue = Right(cellValue, 4)
            ' その中の左から2文字を取得＝階級
            left2 = Left(cellValue, 2)
            ' その中の右から2文字を取得＝支部
            right2 = Right(cellValue, 2)
            ws.Cells(i, 5).Value = left2
            ws.Cells(i, 6).Value = right2
        Else
        End If
    Next i
End Sub

こんな感じ。

Column1の情報整理、完了(*'ω'*)

…いい感じ(*'ω'*)

Column2の整理。剣が峰。。。

登録番号、レーサーの名前、支部、グレードをセル分割できました。
ここからColumn2のデータ整理になりますが。

血液型と前(前前/前前前)回グレードごとの場合分けになりまして。

ﾒﾝﾄﾞｸｻ(´;ω;｀)

でも、できた。こんな感じ。

抜粋(*'ω'*)

これで半年分のデータ整理ができまして、
やっとpythonで分析できる形式になりました。
レーサーごとの2枠出走時勝率とか、勝利回数とか！
わたしが使いたいデータがしっかりと！！！嬉しい(^^)

最後のデータ整理コードとフォーマットファイルは
↓ からご確認お願いします！(´-ω-`)

記事見てくれてありがとう🐣