ここから本文です

VBAで質問です、

egj********さん

2019/4/1913:24:01

VBAで質問です、

最終受験日を見て、次の受験日と失効日(3年後)が自動で計算されるようになっているのですが、再検査をした場合、次受験日〜失効日までの期間が短くなってしまいます。そのため、再検査をした人は、失効までの期間が短くなるので、次受験日を、一つ前にしたいのです。
※次受験日は五月、十一月のみ。

ご知恵をお貸しください。よろしくお願い申し上げます。



現在のプログラムは下記のとおりです。


Public Sub kureperin()
Dim i As Integer
Dim j As Integer
Dim head As Integer
Dim LoopFlag As Integer

Dim cellstandard As Integer
Dim tmp_count As Integer
Dim buf As Variant

'一番上の職員の、予定受検時期セルが左から何番目に位置しているか
cellstandard = 6

'職員が一人も記入されていなければ終了
If Cells(3, 2).Value = "" Then
Exit Sub
End If

'再下端の行数を、職員氏名での存在で調べる
tmp_count = 3
Do While Cells(tmp_count, 2).Value <> ""
tmp_count = tmp_count + 1
Loop
tmp_count = tmp_count - 1

'有効期限を計算して表示
For i = 3 To tmp_count
If IsDate(Cells(i, cellstandard - 1)) = True Then
Cells(i, cellstandard + 1) = DateAdd("yyyy", 3, Cells(i, cellstandard - 1))

Else
Cells(i, cellstandard + 1) = ""

End If
Next

'セルを見て、三年後のセルを一カ月単位で減算し、
'クレペリン受検月になったら返す
For i = 3 To tmp_count
buf = Cells(i, cellstandard + 1)

If IsDate(buf) = True Then
Do While True
buf = DateAdd("m", -1, buf)

If Month(buf) = Sheets("settings").Cells(3, 3) Or Month(buf) = Sheets("settings").Cells(4, 3) Then
Cells(i, cellstandard) = buf
Exit Do
End If
Loop

'もし日付以外の数値だったら空にする
Else
Cells(i, cellstandard) = ""

End If

Next
End Sub

cellstandard,settings&amp;quot,If IsDate,End If,True Then,F&amp;quot,DateSerial

閲覧数:
78
回答数:
2

違反報告

ベストアンサーに選ばれた回答

kky********さん

2019/4/2011:35:25

「settings」というシートのC3とC4セルに受験月が指定してあるようですが、C3<C4となるようにして下さい。5月と11月ならC3に5、C4に11です。

Do ~ Loop より、まず For ~ Next を使う方がいいと思います。
勿論 Do ~ Loop しか使えない処理もありますが。

Sub Sample()
Dim i As Long
Dim con1 As Integer, con2 As Integer
With Worksheets("settings")
con1 = .Range("C3").Value
con2 = .Range("C4").Value
End With
With ActiveSheet
For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row
.Range("G" & i).Value = DateAdd("yyyy", 3, .Range("E" & i).Value)
.Range("G" & i).NumberFormatLocal = "ggge年m月d日"
If Month(.Range("G" & i)) <= con1 Then
'前年のcon2
.Range("F" & i) = DateSerial(Year(.Range("G" & i)) - 1, con2, 1)
Else
'今年のcon1
.Range("F" & i) = DateSerial(Year(.Range("G" & i)), con1, 1)
End If
.Range("F" & i).NumberFormatLocal = "ggge年m月"
If .Range("D" & i).Value = "再検査" Then
If Month(.Range("F" & i)) <= con1 Then
.Range("F" & i) = DateSerial(Year(.Range("F" & i)) - 1, con2, 1)
Else
.Range("F" & i) = DateSerial(Year(.Range("F" & i)), con1, 1)
End If
End If
Next i
End With
End Sub

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

質問した人からのコメント

2019/4/25 17:18:42

非常に助かりました、ありがとうございました^ ^

ベストアンサー以外の回答

1〜1件/1件中

kak********さん

2019/4/2009:15:24

再検査をした人かどうかの情報はどこ(どの列)に格納されているのでしょうか?

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる