TOTO予想ソフトを作ってみよう　「登録」ボタンの設置　その2

TOTO予想ソフトを作ってみよう

Step 5 「登録」ボタンの設置　その2
入力データをT戦績シートにコピーします。

シートコード

下記のコードを追加してください
Private Sub InputDataSave(srow As String)
    Dim i As Integer
    Dim scell As String

    Sheets("戦績入力").Select

    Sheets("T戦績").Range(srow) = Range("F2")

    scell = A1Add(srow, 0, 1)
    Sheets("T戦績").Range(scell) = Range("H2")

    Range("F5").Select
    scell = A1Add(srow, 0, 2)
    For i = 0 To 12
        '入力したデータをコピー
        Range(ActiveCell.Offset(rowOffset:=i, columnOffset:=0), _
            ActiveCell.Offset(rowOffset:=i, columnOffset:=6)).Copy
        'ペースト
        Sheets("T戦績").Range(scell).Offset(0, i * 7).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
    Next

    Application.Goto Reference:=Sheets("T戦績").Range(srow), Scroll:=True

    Sheets("戦績入力").Select

    'コピーモードの解除
    Application.CutCopyMode = False
End Sub

下記のコードに変更してください。
Private Sub InputDataSave(srow As String)
    Dim i As Integer
    Dim scell As String

    Sheets("戦績入力").Select

    Sheets("T戦績").Range(srow) = Range("F2")

    scell = A1Add(srow, 0, 1)
    Sheets("T戦績").Range(scell) = Range("H2")

    Range("F5").Select
    scell = A1Add(srow, 0, 2)
    For i = 0 To 12
        '入力したデータをコピー
        Range(ActiveCell.Offset(rowOffset:=i, columnOffset:=0), _
            ActiveCell.Offset(rowOffset:=i, columnOffset:=6)).Copy
        'ペースト
        Sheets("T戦績").Range(scell).Offset(0, i * 7).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
    Next

    Application.Goto Reference:=Sheets("T戦績").Range(srow), Scroll:=True

    Sheets("戦績入力").Select

    'コピーモードの解除
    Application.CutCopyMode = False

End Sub

標準モジュールコード

下記のコードを追加してください

'A1形式位置の加算位置､減算位置
Public Function A1Add(sa As String, nr As Long, nc As Long) As String
    Dim i As Long
    Dim j As Long
    Dim srow As String
    Dim scol As String
    Dim lrow As Long
    Dim lcol As Long

    srow = ""
    scol = ""
    sa = UCase(sa)
    '行列を分ける
    For i = 1 To Len(sa)
        If Mid(sa, i, 1) >= "A" And Mid(sa, i, 1) <= "Z" Then
            srow = srow & Mid(sa, i, 1)
        ElseIf Mid(sa, i, 1) <> "$" Then
            scol = scol & Mid(sa, i, 1)
        End If
    Next

    'A1形式の列を列番号にする
    If Len(srow) = 1 Then
        lrow = Asc(srow) - 64
    Else
        lrow = (Asc(Left(srow, 1)) - 64) * 26
        lrow = lrow + (Asc(Right(srow, 1)) - 64)
    End If

    '加算
    If nc > 0 Then
        If lrow + nc <= 65536 Then
            lrow = lrow + nc
        End If
    ElseIf nc < 0 Then
        If lrow + nc >= 1 Then
            lrow = lrow + nc
        End If
    End If

    '列番号をA1形式に戻す
    If lrow <= 26 Then
        srow = Chr(64 + lrow)
    Else
        i = Int(lrow / 26)
        j = lrow Mod 26
        If j = 0 Then
            srow = Chr(64 + i - 1) & "Z"
        Else
            srow = Chr(64 + i) & Chr(64 + j)
        End If
    End If

    '行番号の加算
    lcol = scol
    If nr > 0 Then
        If lcol + nr <= 65536 Then
            lcol = lcol + nr
        End If
    ElseIf nr < 0 Then
        If lcol + nr >= 1 Then
            lcol = lcol + nr
        End If
    End If
    scol = lcol

    A1Add = srow & scol
End Function

戦績入力画面

	データを入力し「登録」ボタンをクリックします。既に同じ回数が登録されている場合メッセージが表示されます。コピー結果

Topへ