競馬予想ソフト　2024_0714【Update】

2024年7月13日 19:06

こんにちは。slash_slashです。
競馬資料のリニューアル 6　（続き）
今年にやりたい事は以前ここに書いたと思います。その中の一つに『競馬資料のリニューアル』があります。流石に短期間では出来ないので、随時ここに書いていきたいと思います。ただし不定期になると思います。

ゴールデンウィークはそれなりに予定があったのですが、写真を撮りに行く予定が2つ雨で無くなりました。結果的に予定が無くなった日を改修する日に当てる事になりました。

今回の改修はステップとしては4つのステップを踏む事にしました。
1.既存のデータをテキストファイルから読み込み・書き出し
2. EveryDB2でDLしたデータベースを出馬表形式で取り込む
3. EveryDB2でDLしたデータベースを開催内容形式でExcelファイルに表示
4. EveryDB2でDLしたデータベースからその日の結果や各種払い戻し金を表示→この競馬ソフトで利用も含む

今までやった事がない事にある意味チャレンジするので、ゴールデンウィーク期間中には終わらないと思っていました。勉強しながらになるので『5月の終わりまでにステップ4まで終われば』という気持ちで進める事にしました。

1.既存のExcelファイルのデータをテキストファイルから読み込みと書き出し
今の競馬資料のメインとなるExcelファイルは昔から使っていてます。マクロを多数入れている事や、出馬表形式のデータ・結果データを一つのファイルにまとめているので、ファイル容量が20MBを超えています。
なのでファイルを開ける時や、保存する時も時間がかかります。また、ファイルのバックアップの観点から見ても、ファイルとデータを別々に管理する方が良いと思ってました。
競馬資料ファイル開けた時に、テキストデータからシートに読み込み、終了時にはテキストデータに保存するマクロを作りました。作ったといってもネットを探せばVBAコードがあるので、それを自分の環境に合わせて修正したモノです。
結果的にExcelファイルの容量は750KB・テキストデータは何故か20MB。
まぁ分離出来ただけでも良しとします。
ということで、下記のマクロは僕の環境下での一例です。

Sub CSV保存()
Dim csvFile As String
Dim i As Long, j As Long, FileNumber As Integer, LR As Long, LC As Long
Dim ws As Worksheet

    Set ws1 = ThisWorkbook.Worksheets("Top")
    FoPath = ws1.Range("R2")


    For t = 0 To 1
        Select Case t
            Case 0
                'CSVファイルへ出力するシートを指定
                Set ws = ThisWorkbook.Worksheets("data")
                '出力するファイルのパスとファイル名を指定
                csvFile = FoPath & "\data.txt"
                LC = 80
            Case 1
                Set ws = ThisWorkbook.Worksheets("結果")
                csvFile = FoPath & "\結果.txt"
                LC = 12
        End Select
        
        On Error Resume Next
        ws.ShowAllData

        
        'ファイルナンバーを割り当て
        FileNumber = FreeFile
        
        '最終行・最終列を取得
        LR = ws.Cells(Rows.Count, "A").End(xlUp).Row
        'ファイルへの書き出し
        Open csvFile For Output As #FileNumber
        
        '1列全て書き出したら、次の行へ
        For i = 2 To LR
            For j = 1 To LC
                If j <> LC Then
                    Print #FileNumber, ws.Cells(i, j).Value & ","; '最終列でなければセルの値とカンマ　タブの場合→vbTab;
                Else
                    Print #FileNumber, ws.Cells(i, j).Value & vbCr;  '最終列ならば、セルの値と改行コード
                End If
            Next j
        Next i
        
        'ファイルを閉じる
        Close #FileNumber
        
        'データCSV保存のフラグ
        If Worksheets("Top").Range("Q5") = "" Then
            ws.Rows("2:" & i).Delete
        End If

    Next

End Sub


Sub CSV読み込み()
    Dim buf As String, A As Variant, i As Long, j As Long
    Dim csvFile As String
    
    Set ws1 = ThisWorkbook.Worksheets("Top")
    FoPath = ws1.Range("R2")
    
    
    For t = 0 To 1
        Select Case t
            Case 0
                'CSVファイルへ出力するシートを指定
                Set ws = ThisWorkbook.Worksheets("data")
                '出力するファイルのパスとファイル名を指定
                csvFile = FoPath & "\data.txt"
                LC = 80
            Case 1
                Set ws = ThisWorkbook.Worksheets("結果")
                csvFile = FoPath & "\結果.txt"
                LC = 12
        End Select
        
        i = 0
        
        ReDim b(999999, LC)
        Open csvFile For Input As #1
            Do Until EOF(1)
                Line Input #1, buf
                A = Split(buf, ",")      'タブの場合→A = Split(buf, vbTab)
                For j = 0 To UBound(A)
                    b(i, j) = A(j)
                Next j
                i = i + 1
            Loop
        Close #1
        ws.Range("A2").Resize(200000, LC) = b   ''1回だけ代入
    Next
    
End Sub