MENU
ITで縁を紡ぐ
  1. ホーム
  2. Excel
  3. VBAテキストボックス日付判定と入力補完を徹底解説【完全ガイド】

VBAテキストボックス日付判定と入力補完を徹底解説【完全ガイド】

広告
Excel

こんにちは！大阪市住之江区に拠点を置く会社『縁紡ぐ』の稲垣です。

当社は、Excel、ACCESS、RPAなどのシステム開発や既存ツールを使った業務効率化の提案、また、ITスキルアップのための教育に力を入れています。効率的なビジネス運営を目指している企業様、ITスキルの向上を図りたい企業や個人の方に、最適なご提案をさせていただきます。業務プロセスの改善とITスキルアップをサポートし、共に成長するパートナーでありたいと考えています。

目次

はじめに

Excelユーザーフォームなどを使用する際に、日付入力は非常に多くでてきますが、ユーザーが日付を入力する際に、誤った形式で入力してしまうことがよくあります。例えば、「2024/08/05」を「0805」や「8/5」、「8-5」のように入力することがあります。

そのような入力をVBAを使って日付を自動補完し、さらに有効な日付かどうかをチェックすることで、正確なデータ入力を実現することができます。この記事では、具体的なVBAコードとその日付チェックの方法を詳しく解説します。

VBAで日付入力を自動補完するメリット

VBAを使って日付入力を自動補完することで、以下のメリットがあります。

入力ミスの防止

ユーザーが誤った形式で日付を入力しても、自動で正しい形式に補完されます

ユーザーフレンドリー

ユーザーが簡単に日付を入力できるようになり、操作性が向上します

データの一貫性

全ての日付が統一された形式で入力されるため、データの一貫性が保たれます

これらのメリットにより、データ管理がより効率的かつ正確になります。

VBAコードの詳細解説

それでは、日付入力を自動補完するためのVBAコードを順を追って解説します。

全体のコード

モジュール名を「DateValidationModule」とします。

Public Sub validateAndCompleteDate(ByRef TextBox As MSForms.TextBox, ByVal Cancel As MSForms.ReturnBoolean)
    On Error GoTo ErrorHandler
    
    Dim strDate As String
    strDate = Trim(TextBox.Text) ' 入力された文字列の前後の空白を削除
    
    If strDate = "" Then
        ' 入力が空の場合はそのまま終了
        Exit Sub
    End If
    
    ' 省略された区切り文字の補完
    strDate = replaceDateDelimiters(strDate)
    
    ' 日付の自動補完
    strDate = completePartialDate(strDate)
    
    ' 補完後の日付の有効性チェック
    If Not isDateValid(strDate) Then
        GoTo InvalidDate
    End If
    
    ' 日付が有効であれば、背景色を白に戻す
    TextBox.Text = strDate
    TextBox.BackColor = vbWhite
    Exit Sub
    
InvalidDate:
    MsgBox "有効な日付を入力してください。（YYYY/MM/DD, YYMMDD, MM/DD, MMDD）", vbExclamation
    TextBox.BackColor = vbRed
    Cancel = True
    Exit Sub
    
ErrorHandler:
    MsgBox "入力形式が正しくありません。", vbExclamation
    TextBox.BackColor = vbRed
    Cancel = True
End Sub

' 区切り文字を補完する処理
Private Function replaceDateDelimiters(ByVal strDate As String) As String
    strDate = Replace(strDate, "-", "/")
    strDate = Replace(strDate, ".", "/")
    strDate = Replace(strDate, " ", "/")
    replaceDateDelimiters = strDate
End Function

' 部分的な日付を補完する処理
Private Function completePartialDate(ByVal strDate As String) As String
    Dim currentYear As Integer
    Dim nextYear As Integer
    Dim currentMonth As Integer
    Dim monthPart As Integer
    Dim dayPart As Integer
    Dim yearPart As Integer
    
    currentYear = Year(Date)
    nextYear = currentYear + 1
    currentMonth = Month(Date)
    
    If isDatePartial(strDate) Then
        Dim dateParts() As String
        dateParts = Split(strDate, "/")
        If UBound(dateParts) = 1 Then
            monthPart = CInt(dateParts(0))
            dayPart = CInt(dateParts(1))
            strDate = currentYear & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
        End If
    ElseIf IsNumeric(strDate) Then
        Select Case Len(strDate)
            Case 3 ' MDD
                monthPart = CInt(Left(strDate, 1))
                dayPart = CInt(Right(strDate, 2))
                strDate = currentYear & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            Case 4 ' MMDD
                monthPart = CInt(Left(strDate, 2))
                dayPart = CInt(Right(strDate, 2))
                If currentMonth >= 10 And monthPart <= 3 Then
                    strDate = nextYear & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
                Else
                    strDate = currentYear & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
                End If
            Case 5 ' YYMDD
                yearPart = CInt(Left(strDate, 2))
                monthPart = CInt(Mid(strDate, 3, 1))
                dayPart = CInt(Right(strDate, 2))
                strDate = "20" & Format(yearPart, "00") & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            Case 6 ' YYMMDD
                yearPart = CInt(Left(strDate, 2))
                monthPart = CInt(Mid(strDate, 3, 2))
                dayPart = CInt(Right(strDate, 2))
                strDate = "20" & Format(yearPart, "00") & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            Case 7 ' YYYYMDD
                yearPart = CInt(Left(strDate, 4))
                monthPart = CInt(Mid(strDate, 5, 1))
                dayPart = CInt(Right(strDate, 2))
                strDate = Format(yearPart, "0000") & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            Case 8 ' YYYYMMDD
                yearPart = CInt(Left(strDate, 4))
                monthPart = CInt(Mid(strDate, 5, 2))
                dayPart = CInt(Right(strDate, 2))
                strDate = Format(yearPart, "0000") & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
        End Select
    Else
        dateParts = Split(strDate, "/")
        If UBound(dateParts) = 1 Then
            monthPart = CInt(dateParts(0))
            dayPart = CInt(dateParts(1))
            If currentMonth >= 10 And monthPart <= 3 Then
                strDate = nextYear & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            Else
                strDate = currentYear & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            End If
        ElseIf UBound(dateParts) = 2 Then
            yearPart = CInt(dateParts(0))
            monthPart = CInt(dateParts(1))
            dayPart = IIf(Len(dateParts(2)) > 0, CInt(dateParts(2)), 1)
            If yearPart < 100 Then
                strDate = "20" & Format(yearPart, "00") & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            Else
                strDate = Format(yearPart, "0000") & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            End If
        End If
    End If
    completePartialDate = strDate
End Function

Public Function isDateValid(ByVal strDate As String) As Boolean
    Dim dt As Date
    On Error GoTo InvalidDate
    dt = DateSerial(CInt(Left(strDate, 4)), CInt(Mid(strDate, 6, 2)), CInt(Right(strDate, 2)))
    If Year(dt) < 1900 Then
        isDateValid = False
    ElseIf Year(dt) = CInt(Left(strDate, 4)) And Month(dt) = CInt(Mid(strDate, 6, 2)) And day(dt) = CInt(Right(strDate, 2)) Then
        isDateValid = True
    Else
        isDateValid = False
    End If
    Exit Function
InvalidDate:
    isDateValid = False
End Function

Public Function isDatePartial(ByVal strDate As String) As Boolean
    Dim dateParts() As String
    dateParts = Split(strDate, "/")
    
    If UBound(dateParts) = 1 Then
        If IsNumeric(dateParts(0)) And IsNumeric(dateParts(1)) Then
            isDatePartial = True
            Exit Function
        End If
    End If
    
    isDatePartial = False
End Function

利用する時の方法

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Call DateValidationModule.validateAndCompleteDate(Me.TextBox1, Cancel)
End Sub

日付区切り文字の自動補完

ユーザーが日付を入力する際に、ハイフンやドットなどの区切り文字を使う場合があります。この部分を自動的に補完するコードは以下の通りです。

Private Function replaceDateDelimiters(ByVal strDate As String) As String
    strDate = Replace(strDate, "-", "/")
    strDate = Replace(strDate, ".", "/")
    strDate = Replace(strDate, " ", "/")
    replaceDateDelimiters = strDate
End Function

このコードでは、入力された日付の区切り文字がハイフンやドットだった場合、それをスラッシュ（/）に置き換えます。これにより、日付形式が統一され、補完処理が容易になります。ほかにも、変換したいものがあった場合は、追加してくださいね。

部分的な日付入力の補完

次に、ユーザーが部分的にしか日付を入力しなかった場合、その日付を補完するコードです。

Private Function completePartialDate(ByVal strDate As String) As String
    Dim currentYear As Integer
    Dim nextYear As Integer
    Dim currentMonth As Integer
    Dim monthPart As Integer
    Dim dayPart As Integer
    Dim yearPart As Integer
    
    currentYear = Year(Date)
    nextYear = currentYear + 1
    currentMonth = Month(Date)
    
    If isDatePartial(strDate) Then
        Dim dateParts() As String
        dateParts = Split(strDate, "/")
        If UBound(dateParts) = 1 Then
            monthPart = CInt(dateParts(0))
            dayPart = CInt(dateParts(1))
            strDate = currentYear & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
        End If
    ElseIf IsNumeric(strDate) Then
        Select Case Len(strDate)
            Case 3 ' MDD
                monthPart = CInt(Left(strDate, 1))
                dayPart = CInt(Right(strDate, 2))
                strDate = currentYear & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            Case 4 ' MMDD
                monthPart = CInt(Left(strDate, 2))
                dayPart = CInt(Right(strDate, 2))
                If currentMonth >= 10 And monthPart <= 3 Then
                    strDate = nextYear & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
                Else
                    strDate = currentYear & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
                End If
            Case 5 ' YYMDD
                yearPart = CInt(Left(strDate, 2))
                monthPart = CInt(Mid(strDate, 3, 1))
                dayPart = CInt(Right(strDate, 2))
                strDate = "20" & Format(yearPart, "00") & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            Case 6 ' YYMMDD
                yearPart = CInt(Left(strDate, 2))
                monthPart = CInt(Mid(strDate, 3, 2))
                dayPart = CInt(Right(strDate, 2))
                strDate = "20" & Format(yearPart, "00") & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            Case 7 ' YYYYMDD
                yearPart = CInt(Left(strDate, 4))
                monthPart = CInt(Mid(strDate, 5, 1))
                dayPart = CInt(Right(strDate, 2))
                strDate = Format(yearPart, "0000") & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            Case 8 ' YYYYMMDD
                yearPart = CInt(Left(strDate, 4))
                monthPart = CInt(Mid(strDate, 5, 2))
                dayPart = CInt(Right(strDate, 2))
                strDate = Format(yearPart, "0000") & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
        End Select
    Else
        dateParts = Split(strDate, "/")
        If UBound(dateParts) = 1 Then
            monthPart = CInt(dateParts(0))
            dayPart = CInt(dateParts(1))
            If currentMonth >= 10 And monthPart <= 3 Then
                strDate = nextYear & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            Else
                strDate = currentYear & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            End If
        ElseIf UBound(dateParts) = 2 Then
            yearPart = CInt(dateParts(0))
            monthPart = CInt(dateParts(1))
            dayPart = IIf(Len(dateParts(2)) > 0, CInt(dateParts(2)), 1)
            If yearPart < 100 Then
                strDate = "20" & Format(yearPart, "00") & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            Else
                strDate = Format(yearPart, "0000") & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            End If
        End If
    End If
    completePartialDate = strDate
End Function

このコードでは、ユーザーが「MMDD（0801)」や「MDD(801)」のように部分的に日付を入力した場合に、それを現在の年や翌年と組み合わせて正しい日付形式「2024/08/01」に補完します。

日付の有効性チェック

最後に、補完された日付が実際に存在する日付かどうかを確認するコードです。1900年以降の日付を有効としています。

もし、入力が2020年以降しかないのであれば、If Year(dt) < 1900 Then　の1900を変更してください。

Public Function isDateValid(ByVal strDate As String) As Boolean
    Dim dt As Date
    On Error GoTo InvalidDate
    dt = DateSerial(CInt(Left(strDate, 4)), CInt(Mid(strDate, 6, 2)), CInt(Right(strDate, 2)))
    If Year(dt) < 1900 Then
        isDateValid = False
    ElseIf Year(dt) = CInt(Left(strDate, 4)) And Month(dt) = CInt(Mid(strDate, 6, 2)) And day(dt) = CInt(Right(strDate, 2)) Then
        isDateValid = True
    Else
        isDateValid = False
    End If
    Exit Function
InvalidDate:
    isDateValid = False
End Function

このコードでは、補完後の日付が実際に存在するかどうかを確認し、無効な日付であればFalse返します。

利用する時

日付の補完とチェックのモジュールを利用する時は、以下のコードになります。

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Call DateValidationModule.validateAndCompleteDate(Me.TextBox1, Cancel)
End Sub

テキストボックス名（サンプルではTextBox1)は、適宜変更してください。

まとめ

GPT

VBAで日付入力を自動補完する方法を徹底解説【完全ガイド】

VBA（Visual Basic for Applications）を使って、日付入力を自動補完し、入力ミスを防ぐ方法について詳しく解説します。特に、Excelユーザーフォームなどで日付を入力する際、ユーザーが意図せず間違った形式で日付を入力してしまうことがあります。この記事では、そのようなミスを自動的に補正し、正確な日付を補完するVBAコードの実装方法を紹介します。

目次

  1. はじめに
  2. VBAで日付入力を自動補完するメリット
  3. VBAコードの詳細解説
    1. 日付区切り文字の自動補完
    2. 部分的な日付入力の補完
    3. 日付の有効性チェック
  4. 実際の利用シーン
  5. まとめ

<a id=”はじめに”></a>

1. はじめに

Excelユーザーフォームなどを使用する際に、日付入力は非常に重要です。しかし、ユーザーが日付を入力する際に、誤った形式で入力してしまうことがしばしばあります。例えば、「2024年8月5日」を「0805」や「8/5」のように入力してしまうことがあります。

そのような入力ミスを防ぐために、VBAを使って日付を自動補完し、さらに有効な日付かどうかをチェックすることで、正確なデータ入力を実現します。この記事では、具体的なVBAコードとその仕組みを詳しく解説します。

<a id=”vbaで日付入力を自動補完するメリット”></a>

2. VBAで日付入力を自動補完するメリット

VBAを使って日付入力を自動補完することで、以下のメリットがあります。

  • 入力ミスの防止: ユーザーが誤った形式で日付を入力しても、自動で正しい形式に補完されます。
  • ユーザーフレンドリー: ユーザーが簡単に日付を入力できるようになり、操作性が向上します。
  • データの一貫性: 全ての日付が統一された形式で入力されるため、データの一貫性が保たれます。

これらのメリットにより、データ管理がより効率的かつ正確になります。

<a id=”vbaコードの詳細解説”></a>

3. VBAコードの詳細解説

それでは、日付入力を自動補完するためのVBAコードを順を追って解説します。

<a id=”日付区切り文字の自動補完”></a>

A. 日付区切り文字の自動補完

ユーザーが日付を入力する際に、ハイフンやドットなどの区切り文字を使う場合があります。この部分を自動的に補完するコードを以下に示します。

vbaコードをコピーするPrivate Function replaceDateDelimiters(ByVal strDate As String) As String
    strDate = Replace(strDate, "-", "/")
    strDate = Replace(strDate, ".", "/")
    strDate = Replace(strDate, " ", "/")
    replaceDateDelimiters = strDate
End Function

このコードでは、入力された日付の区切り文字がハイフンやドットだった場合、それをスラッシュ（/）に置き換えます。これにより、日付形式が統一され、補完処理が容易になります。

<a id=”部分的な日付入力の補完”></a>

B. 部分的な日付入力の補完

次に、ユーザーが部分的にしか日付を入力しなかった場合、その日付を補完するコードです。

vbaコードをコピーするPrivate Function completePartialDate(ByVal strDate As String) As String
    Dim currentYear As Integer
    Dim nextYear As Integer
    Dim currentMonth As Integer
    Dim monthPart As Integer
    Dim dayPart As Integer
    Dim yearPart As Integer
    
    currentYear = Year(Date)
    nextYear = currentYear + 1
    currentMonth = Month(Date)
    
    If isDatePartial(strDate) Then
        Dim dateParts() As String
        dateParts = Split(strDate, "/")
        If UBound(dateParts) = 1 Then
            monthPart = CInt(dateParts(0))
            dayPart = CInt(dateParts(1))
            strDate = currentYear & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
        End If
    ElseIf IsNumeric(strDate) Then
        Select Case Len(strDate)
            Case 3 ' MDD
                monthPart = CInt(Left(strDate, 1))
                dayPart = CInt(Right(strDate, 2))
                strDate = currentYear & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            Case 4 ' MMDD
                monthPart = CInt(Left(strDate, 2))
                dayPart = CInt(Right(strDate, 2))
                If currentMonth >= 10 And monthPart <= 3 Then
                    strDate = nextYear & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
                Else
                    strDate = currentYear & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
                End If
            Case 5 ' YYMDD
                yearPart = CInt(Left(strDate, 2))
                monthPart = CInt(Mid(strDate, 3, 1))
                dayPart = CInt(Right(strDate, 2))
                strDate = "20" & Format(yearPart, "00") & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            Case 6 ' YYMMDD
                yearPart = CInt(Left(strDate, 2))
                monthPart = CInt(Mid(strDate, 3, 2))
                dayPart = CInt(Right(strDate, 2))
                strDate = "20" & Format(yearPart, "00") & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            Case 7 ' YYYYMDD
                yearPart = CInt(Left(strDate, 4))
                monthPart = CInt(Mid(strDate, 5, 1))
                dayPart = CInt(Right(strDate, 2))
                strDate = Format(yearPart, "0000") & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            Case 8 ' YYYYMMDD
                yearPart = CInt(Left(strDate, 4))
                monthPart = CInt(Mid(strDate, 5, 2))
                dayPart = CInt(Right(strDate, 2))
                strDate = Format(yearPart, "0000") & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
        End Select
    Else
        dateParts = Split(strDate, "/")
        If UBound(dateParts) = 1 Then
            monthPart = CInt(dateParts(0))
            dayPart = CInt(dateParts(1))
            If currentMonth >= 10 And monthPart <= 3 Then
                strDate = nextYear & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            Else
                strDate = currentYear & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            End If
        ElseIf UBound(dateParts) = 2 Then
            yearPart = CInt(dateParts(0))
            monthPart = CInt(dateParts(1))
            dayPart = IIf(Len(dateParts(2)) > 0, CInt(dateParts(2)), 1)
            If yearPart < 100 Then
                strDate = "20" & Format(yearPart, "00") & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            Else
                strDate = Format(yearPart, "0000") & "/" & Format(monthPart, "00") & "/" & Format(dayPart, "00")
            End If
        End If
    End If
    completePartialDate = strDate
End Function

このコードでは、ユーザーが「MMDD」や「MDD」のように部分的に日付を入力した場合に、それを現在の年や翌年と組み合わせて正しい日付形式に補完します。

<a id=”日付の有効性チェック”></a>

C. 日付の有効性チェック

最後に、補完された日付が実際に存在するかどうかを確認するコードです。

vbaコードをコピーするPublic Function isDateValid(ByVal strDate As String) As Boolean
    Dim dt As Date
    On Error GoTo InvalidDate
    dt = DateSerial(CInt(Left(strDate, 4)), CInt(Mid(strDate, 6, 2)), CInt(Right(strDate, 2)))
    If Year(dt) < 1900 Then
        isDateValid = False
    ElseIf Year(dt) = CInt(Left(strDate, 4)) And Month(dt) = CInt(Mid(strDate, 6, 2)) And day(dt) = CInt(Right(strDate, 2)) Then
        isDateValid = True
    Else
        isDateValid = False
    End If
    Exit Function
InvalidDate:
    isDateValid = False
End Function

このコードでは、補完後の日付が実際に存在するかどうかを確認し、無効な日付であればエラーメッセージを表示します。

<a id=”実際の利用シーン”></a>

4. 実際の利用シーン

このVBAコードは、Excelユーザーフォームやデータ入力シートなど、ユーザーが日付を入力する場面で非常に役立ちます。特に、大量のデータを管理する際に、ユーザーの入力ミスを減らし、データの一貫性を保つことが可能です。

<a id=”まとめ”></a>

5. まとめ

本記事では、VBAを使って日付入力を自動補完し、入力ミスを防ぐ方法について詳しく解説しました。このような自動補完機能を実装することで、ユーザーの操作性を向上させ、データの信頼性を高めることができます。

日付入力の補完や有効性チェックは、業務効率を上げるために非常に有効な手段です。ぜひ、あなたのシステムにも取り入れてみてください。

この記事が役立ったと感じたら、ぜひシェアしてください。また、他のVBAテクニックについても今後解説していきますので、お見逃しなく！

合同会社縁紡ぐ
【VBA】コピペ実行で作れるカレンダーフォーム（実践例も紹介） | 合同会社縁紡ぐ VBAでカレンダー入力を作成する 作り方の手順 STEP標準モジュールに下記コードをコピペする Sub CreateCalendarForm() Dim myForm As Object Dim btn As MSForms.Command
記事を書いた人

稲垣

  • Excel、ACCESSでのシステム開発が得意
  • ITスキルを共有し実践的に学びながら成長する人を見るのが幸せ
  • 自家焙煎するほどのコーヒー好き
  • 使用言語 VBA、Python、Javascript、Java、HTML、CSS etc.
  • 保有資格　Kintoneアソシエイト、日商簿記検定２級、マンション管理士、管理業務主任者、情報セキュリティマネジメント、ExcelVBA　etc.
  • 業務フロー図の作成や業務時間分析を通して、効率化ポイントを探る人
  • お客様にとって本当に良いことかを第一に考える人
Excel
よかったらシェアしてね！
  • URLをコピーしました！
  • URLをコピーしました！

コメント

コメントする

目次