|
下記のコードを追加してください
'日付のチェック
Private Function datecheck(scl As String) As Boolean
Dim lv As Long
datecheck = False
On Error GoTo ErrRtn
If IsDate(Range(scl)) Then
datecheck = True
Exit Function
End If
ErrRtn:
Beep
Range(scl).Select
MsgBox "日付が不正です。修正してください。", , "TOTO予想Excel"
End Function
'数値のチェック
Private Function valcheck(scl As String) As Long
Dim lv As Long
valcheck = -1
On Error GoTo ErrRtn
If IsNumeric(Range(scl)) Then
lv = Val(Range(scl))
valcheck = lv
Exit Function
End If
ErrRtn:
Beep
Range(scl).Select
MsgBox "数値が不正です。修正してください。", , "TOTO予想Excel"
End Function
'入力データのチェック
Private Function InputDataCheck() As Boolean
Dim lv As Long
Dim i As Integer
Dim j As Integer
Dim s As String
Dim bok As Boolean
Dim nclub(25) As Integer
InputDataCheck = False
'回数のチェック
lv = valcheck("F2")
If lv <= 0 Then
If lv = 0 Then
Beep
Range("F2").Select
MsgBox "回数は1以上を入力してください。", , "TOTO予想Excel"
End If
Exit Function
End If
'日付のチェック
If Not datecheck("H2") Then
Exit Function
End If
'クラブ名のチェック
bok = True
Range("G5").Select
For i = 0 To 12
'ホーム
s = ActiveCell.Offset(rowOffset:=i)
If s = "" Then
Beep
ActiveCell.Offset(rowOffset:=i, columnOffset:=-1).Select
MsgBox "ホームのクラブNo.を入力してください。", , "TOTO予想Excel"
bok = False
Exit For
Else
nclub(i) = ActiveCell.Offset(rowOffset:=i, columnOffset:=-1)
For j = 0 To 25
If nclub(j) = 0 Then
Exit For
End If
If i <> j Then
If nclub(i) = nclub(j) Then
Beep
ActiveCell.Offset(rowOffset:=i, columnOffset:=-1).Select
MsgBox "ホームのクラブNo.が2重登録されています。修正してください。", , _
"TOTO予想Excel"
bok = False
Exit For
End If
End If
Next
End If
If bok = False Then
Exit For
End If
'アウェイ
s = ActiveCell.Offset(rowOffset:=i, columnOffset:=4)
If s = "" Then
Beep
ActiveCell.Offset(rowOffset:=i, columnOffset:=3).Select
MsgBox "アウェイのクラブNo.を入力してください。", , "TOTO予想Excel"
bok = False
Exit For
Else
nclub(i + 13) = ActiveCell.Offset(rowOffset:=i, columnOffset:=3)
For j = 0 To 25
If nclub(j) = 0 Then
Exit For
End If
If i + 13 <> j Then
If nclub(i + 13) = nclub(j) Then
Beep
ActiveCell.Offset(rowOffset:=i, columnOffset:=3).Select
MsgBox "ホームのクラブNo.が2重登録されています。修正してください。", , _
"TOTO予想Excel"
bok = False
Exit For
End If
End If
Next
End If
If bok = False Then
Exit For
End If
Next
If bok = False Then
Exit Function
End If
'結果のチェック
bok = True
Range("L5").Select
For i = 0 To 12
'数値チェック
lv = valcheck(ActiveCell.Offset(rowOffset:=i, columnOffset:=-4).Address)
If lv < 0 Then
bok = False
Exit For
End If
'数値チェック
lv = valcheck(ActiveCell.Offset(rowOffset:=i, columnOffset:=-3).Address)
If lv < 0 Then
bok = False
Exit For
End If
'得点チェック
s = ActiveCell.Offset(rowOffset:=i)
If s = "" Then
Beep
ActiveCell.Offset(rowOffset:=i, columnOffset:=-4).Select
MsgBox "得点を入力されていないか、不正です。", , "TOTO予想Excel"
bok = False
Exit For
End If
Next
If bok = False Then
Exit Function
End If
InputDataCheck = True
End Function
Private Sub CommandButton1_Click()
InputDataCheck
End Sub |
|
|
|