質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.49%

  • VBA

    1854questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

実行ボタン押下(2連続)をすると、ユーザの入力したデータが20日分プラスされてしまう。

解決済

回答 2

投稿

  • 評価
  • クリップ 0
  • VIEW 410

King_of_Flies

score 298

VBAでツールを作成しました。
コメントを多く書いたので、動作の説明は省きます。

このツールにはユーザの入力する箇所が5か所あり、
B3セル = 作業着手実績 入力例: 2017/09/26
B4セル = 作業完了実績 入力例:2017/09/26

B6~B300 = 作業着手予定日 入力例:16/09/26(火)
C6~C300 = 作業完了予定日 入力例:16/09/26(火)
D6~D300 = 作業進捗    入力例:100

というような物になっているのですが、
実行ボタンを押下(一回目)は期待する通りの動作をしてくれのですが、
結果が出た状態で再度実行ボタンを押下すると、
B6~B300,C6~C300の入力した日付が、20日づつ足される現象が起きています。

おそらく、FormatEditorの中で記載している年度合わせに使用した”20” + bar のところが影響しているのだと思いますが、
解決方法を教えて下さい。

あと、コーディングのアドバイスもよろしく承ります。

以下、VBAコード

Const C_START_FIRST As String = "先行着手"
Const C_START As String = "着手"
Const C_START_LATE As String = "遅れ(着手)"
Const C_START_LATED As String = "遅れ(未着手)"
Const C_START_EMP As String = ""

Const C_END_FIRST As String = "先行完了"
Const C_END As String = "完了"
Const C_END_LATE As String = "遅れ(着手)"
Const C_END_LATED As String = "遅れ(未着手)"
Const C_END_EMP As String = ""



'実行ボタン押下で実行。
'ユーザがセルに入力したデータから、Eセル、Fセルにパラメータをセットする。
Sub 実行()
    '入力された日付を指定のフォーマットに変更する。
    Call FormatEditor
    'Eセル、Fセルに文字列をセットする。
    Call CellSetter
    'Eセル、Fセルの文字色を初期化する。
    Call ColorReset
    'Eセル、Fセルから遅れのパラメータを持つデータの文字を赤字に変換する。
    Call ColorSetting
    'A1セルをセレクト状態にする。
    Range("A1").Select
End Sub

'リセットボタン押下で実行。
'ユーザが入力したデータと、実行によって記述されたEセル、Fセルのデータを削除する。
Sub リセット()
    '作業着手実績、作業完了実績に入力された文字を削除する。
    Call DeleteResultDate
    '作業着手予定日、作業完了予定日に入力された文字を削除する。
    Call DeletePlanDate
    'Eセル、Fセルの文字色を初期化する。
    Call ColorReset
    'A1セルをセレクト状態にする。
    Range("A1").Select
End Sub

'入力された作業着手予定日、作業完了予定日の"16/09/26(火)"形式の入力を"2016/09/26"形式に整える。
Sub FormatEditor()

    '作業着手予定日
    For i = 6 To 300
        If Len(Cells(i, 2).Value) > 0 Then
            Cells(i, 2).NumberFormatLocal = "yyyy/m/d;@"
            foo = InStr(Cells(i, 2).Value, "(")
            If foo > 0 Then
                bar = Left(Cells(i, 2).Value, foo - 1)
            Else
                bar = Cells(i, 2).Value
            End If
            Cells(i, 2).Value = CDate("20" + bar)
        Else
            '作業着手予定日が空ならFor文から抜ける。
            Exit For
        End If
    Next i

    '作業完了予定日
    For i = 6 To 300
        If Len(Cells(i, 3).Value) > 0 Then
            Cells(i, 3).NumberFormatLocal = "yyyy/m/d;@"
            foo = InStr(Cells(i, 3).Value, "(")
            If foo > 0 Then
                bar = Left(Cells(i, 3).Value, foo - 1)
            Else
                bar = Cells(i, 3).Value
            End If
            Cells(i, 3).Value = CDate("20" + bar)
        Else
            '作業着手予定日が空ならFor文から抜ける。
            Exit For
        End If
    Next i

End Sub

Sub CellSetter()
    For i = 6 To 300
        '作業着手予定日が空ならFor文から抜ける
        If Cells(i, 2).Value = "" Then
            Exit For
        End If

        '作業着手予定日~ < 作業着手実績日
        If Cells(i, 2).Value < Cells(3, 2).Value Then
            If Cells(i, 4).Value = 0 Then
                Cells(i, 5).Value = C_START_LATED
            ElseIf Cells(i, 4).Value > 0 Then
                Cells(i, 5).Value = C_START_LATE
            End If

        '作業着手予定日~ = 作業着手実績日
        ElseIf Cells(i, 2).Value = Cells(3, 2).Value Then
            If Cells(i, 4).Value = 0 Then
                Cells(i, 5).Value = C_START_LATE
            ElseIf Cells(i, 4).Value > 0 Then
                Cells(i, 5).Value = C_START
            End If

        '作業着手予定日~ > 作業着手実績日
        ElseIf Cells(i, 2).Value > Cells(3, 2).Value Then
            If Cells(i, 4).Value = 0 Then
                Cells(i, 5).Value = C_START_EMP
            ElseIf Cells(i, 4).Value > 0 Then
                Cells(i, 5).Value = C_START_FIRST
            End If
        End If
    Next i

    For i = 6 To 300
        '作業完了予定日が空ならFor文から抜ける
        If Cells(i, 3).Value = "" Then
            Exit For
        End If        

     '作業完了予定日 < 作業完了実績日
        If Cells(i, 3).Value < Cells(3, 3).Value Then
            If Cells(i, 4).Value = 100 Then
                Cells(i, 6).Value = C_END_LATED
            ElseIf Cells(i, 4).Value < 100 Then
                Cells(i, 6).Value = C_END_LATE
            End If

        '作業完了予定日 = 作業完了実績日
        ElseIf Cells(i, 3).Value = Cells(3, 3).Value Then                     
        If Cells(i, 4).Value = 100 Then
                Cells(i, 6).Value = C_END
            ElseIf 100 <> Cells(i, 4).Value Then
                Cells(i, 6).Value = C_END_LATE
            End If

        '作業完了予定日 > 作業完了実績日
        ElseIf Cells(i, 3).Value > Cells(3, 3).Value Then
            If Cells(i, 4).Value = 100 Then
                Cells(i, 6).Value = C_END_FIRST
            ElseIf 100 <> Cells(i, 4).Value Then
                Cells(i, 6).Value = C_END_EMP
            End If
        End If
    Next i

End Sub



'B3,C3セルを削除する。
Sub DeleteResultDate()
    Range("B3:C3").Select
    Selection.ClearContents
End Sub

'B6~E6の下に記入されているデータをすべて削除する。
Sub DeletePlanDate()
    Range("B6:F6").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
End Sub

'D6,E6のセルのカラーリング設定
Sub ColorSetting()
    For i = 6 To 300
        If Cells(i, 5).Value = C_START_LATE Or Cells(i, 5).Value = C_START_LATED Then
            Cells(i, 5).Select
            With Selection.Font
                .ColorIndex = 3
                .TintAndShade = 0
            End With
        End If

        If Cells(i, 6).Value = C_END_LATE Or Cells(i, 6).Value = C_END_LATED Then
            Cells(i, 6).Select
            With Selection.Font
                .ColorIndex = 3
                .TintAndShade = 0
            End With
        End If
    Next i
End Sub

'D6,E6のセルのカラーリング設定を削除する。
Sub ColorReset()
    Range("D6:F6").Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
End Sub

よろしくお願いします。

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 2

check解決した方法

0

解決しました。
Cells(i, 3).Value = CDate("20" + bar)の一行を
If分岐の中で処理させようと思います。

追記
コーディングについてのアドバイスは引き続き受け付けます。

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

0

自己解決されたようですが、問題点を指摘しておきます

使っている変数を宣言していないために意図しない結果になっています
使う変数は必ず宣言して「データ型」を明示しましょう
うまくいかないところはエラーになって教えてくれたり、変数名の打ち間違いやスコープの問題も早く解決できると思います

具体的な問題箇所は以下です

    Cells(i, 2).NumberFormatLocal = "yyyy/m/d;@"
    foo = InStr(Cells(i, 2).Value, "(")
    If foo > 0 Then
       bar = Left(Cells(i, 2).Value, foo - 1)
    Else
       bar = Cells(i, 2).Value
    End If
    Cells(i, 2).Value = CDate("20" + bar)


※同じような処理をしている箇所も同様に

最初の状態でCells(i, 2)に入っている16/09/26(火)文字列と認識されます

変数barどこにも宣言されていないのでVariant型(どのような型のデータでも格納できる特殊な型)となります

bar = Left(Cells(i, 2).Value, foo - 1)

を実行するとVariant型変数 bar に 文字列 が代入されたと認識されます

その後の

Cells(i, 2).Value = CDate("20" + bar)

ですが、"20" + barの部分は"20"をbarに入っている文字列に結合することがおこなわれます

"20" と "16/09/26" の結合で "2016/09/26" となるので、ここまでは狙い通りだと思います

しかし2度目になると問題がおきます

Cells(i, 2)に入っている2016/09/26はエクセルの日付書式として正しいためDateと認識されます

bar = Left(Cells(i, 2).Value, foo - 1)
を実行するとVariant型変数 bar に Date値 が代入されたと認識されます

その後の

Cells(i, 2).Value = CDate("20" + bar)

"20" + barの部分は"20"をbarに入っているDate値(2016/09/26)に加算することがおこなわれます

"2016/09/26" の 20 日後なので "2016/10/16" と計算されます

もしもDim bar As Stringという宣言をしていたら、"20" + barは常に文字列の結合と解釈されるため、2度目の"20" + barを通ると202016/09/26となり、CDateでエラーになるでしょう

(処理の補足として、2回目以降はすでに 20 の文字が先頭に足されているので、20を先頭に足して日付に変換する処理そのものは不要ですね)

このように、変数宣言をしていないと予期しない問題がでてきますので、よほどのことが無い限りは必ず宣言するようにしましょう

なお、宣言忘れを防ぐ方法として、モジュール先頭行に必ずOption Explicitと書くことをおススメします

以上ご参考まで

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/09/26 15:35

    変数宣言をしないで変数を使用するとVariant型になることを今知りました。

    変数に関しては、宣言をStringで固定しようと思います。

    ありがとうございました。

    キャンセル

  • 2017/09/26 15:38 編集

    変数の定義を含めます

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 90.49%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る

  • VBA

    1854questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • トップ
  • VBAに関する質問
  • 実行ボタン押下(2連続)をすると、ユーザの入力したデータが20日分プラスされてしまう。