請求月を自動で表示させたい

質問

Ａ列に作業内容・Ｂ列に作業完了記入欄・Ｃ列に請求月があります。
作業内容　　　作業完了　　　請求月
×××作業　　　　○　　　　　３月
△△△作業　　　　○　　　　　５月
こんな感じです。
今は作業が終わると作業完了欄に○印を入れ、請求月を入力していますが、できれば作業完了欄に○を入力すると、自動で請求月が表示されるようにしたいのです。当然○を入力した日付が基準となります。ただし請求は２０日締めなので、９月２１日～１０月２０日は１０月、１０月２１日～１１月２０日は１１月となります。よろしくお願いします。

回答No.8

ja7awu · ベストアンサー

この内容では、VBAで処理する方法よりないでしょう。

それで良ければ、次の手順でテストしてみてください。

・使用しているシートのシート名タブを右クリックして「コードの表示」を指定します。
・開いたコードウィンドウに下記コードをコピーして貼り付けます。
・Alt+ Q (または、右上隅の×）でウィンドウを閉じ、シートに戻ります。
・メニューから[ツール]-->[マクロ]-->[セキュリティ]で「セキュリティレベル」を
　「中」にして[OK]します。
・以上で設定完了です。　「作業完了」に○を入れてみてください。

(※ 既に「請求月」が入力されている行の"○"をフィルドラッグコピーした場合は、
そのコピー元の「請求月」も、現時点での「請求月」に変更されます。
また、一度入れた"○"を消去した場合は、「請求月」も空白になります。）

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Set Target = Application.Intersect(Range("B:B"), Target)
If Target Is Nothing Then Exit Sub
For Each Rng In Target
　　If Rng.Value = "○" Then
　　　　Application.EnableEvents = False
　　　　If Day(Date) > 20 Then
　　　　　　Rng.Offset(, 1).Value = Month(DateAdd("m", 1, Date)) & "月"
　　　　Else
　　　　　　Rng.Offset(, 1).Value = Month(Date) & "月"
　　　　End If
　　ElseIf Rng.Value = vbNullString Then
　　　　Application.EnableEvents = False
　　　　Rng.Offset(, 1).Value = vbNullString
　　End If
　　Application.EnableEvents = True
Next Rng
End Sub

お礼

ありがとうございました。質問の仕方が悪く迷惑をかけたみたいでが、思う通りの事ができました。本当ありがとうございました。

回答No.7

noname#27115

' #3です。
' 先のは忘れてください。<m(__)m>

' 次のをWorkbook の SheetChangeイベントに貼ってください。

' ドラッグコピーに対応していないのは同じですが。。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Trim(Target.Text) = "○" And Target.Column = 2 Then
Sh.Cells(Target.Row, 3) = IIf(Day(Date) <= 20, _
Month(Date), Month(DateAdd("m", 1, Date))) & "月"
End If
End Sub

回答No.6

imogasi

（１）Ｂ列に円を入れるとする。○を入れるのは、作業完了日に必ず入力するものとして、翌日にずれないものとする。
（２）Ｄ列のＤ２に関数式=IF(B2="○",TODAY(),"")を入れる。そしてＤ３以下に式を複写する。
（３）Ｅ列のＥ２に関数式=IF(D2="","",IF(DAY(D2)<21,EOMONTH(D2,0),EOMONTH(D2,1)))
をいれ、Ｅ３以下に式を複写する。
（４）＃１でご指摘の「明日、同じファイルを開くと、TODAY()の値が変わっているから」を避けます。
Ｓｈｅｅｔ１のＣｈａｎｇｅイベントとして
ＶＢＥ画面に
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then
Cells(Target.Row, "D").Copy
Cells(Target.Row, "D").Select
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End If
End Sub
を貼りつける。
（５）○をドラッグで持ってくる(ケースとしては稀と思うが）と、エラーになりますが、これをさせないことは出来ないかと思案中ですが判りません。
関数だけで、近いところまで出来るのに残念。
Ｅ列をＸＸ月で出したいときは、
=MONTH(E2)&"月のＥ２に上記の式を挟むようにしてください。

回答No.5

ki-aaa

#1です。

作業完了の、○の代わりに、作業完了日を手入力すると、関数でできます。

C1: =IF(B1="","",IF(DAY(B1)>20,IF(MONTH(B1)=12,1,MONTH(B1)+1),MONTH(B1)))

お礼

関数は初めからあきらめていましたが、大変参考になりました。

回答No.4

noname#27115

#3 です。

' ちょっと、簡単にしました。
' 貼り付けるシート名は Sheet1 にしてください。
' もしくは Sheets("Sheet1") のところを使用中
' のシート名にかえてください。

Option Explicit

Dim myRow As Long
Dim myCol As Long

Private Sub Worksheet_Change(ByVal Target As Range)
If myCol = 2 And Trim(Cells(myRow, myCol).Value) = "○" Then
Test ActiveCell.Value, myRow, myCol
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
myRow = ActiveCell.Row
myCol = ActiveCell.Column
End Sub

Private Sub Test(myVal As String, myRow As Long, myCol As Long)
If ActiveCell.Column = 2 Then
Sheets("Sheet1").Cells(myRow, 3) = IIf(Day(Date) <= 20, _
Month(Date), Month(DateAdd("m", 1, Date))) & "月"
End If
End Sub

回答No.3

noname#27115

' #2さんご指摘の"○"をドラッグコピーした時はイベントが発生しないので
' コピペ する必要がありますが、次のコードでも可能です。

' ただ、関数を使うとやっぱり再計算後の値が一緒になってしまう気がするん
' ですよね。

' Alt+F11でVBAエディタを起動し、オブジェクトイクスプローラーで、Sheet1
' をダブルクリック後、次のコードを貼ってください。

' とりあえず、ご参考に。

Option Explicit

Dim myRow As Long
Dim myCol As Long

Private Sub Worksheet_Change(ByVal Target As Range)
If myCol = 2 And Trim(Cells(myRow, myCol).Value) = "○" Then
Test ActiveCell.Value, myRow, myCol
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
myRow = ActiveCell.Row
myCol = ActiveCell.Column
End Sub

Private Sub Test(myVal As String, myRow As Long, myCol As Long)
If ActiveCell.Column = 2 Then
If JudgeDate = -1 Then
If Month(Date) = 12 Then
Sheets("sheet1").Cells(myRow, 3) = 1 & "月"
Else
Sheets("sheet1").Cells(myRow, 3) = Month(Date) + 1 & "月"
End If
Else
Sheets("sheet1").Cells(myRow, 3) = Month(Date) & "月"
End If
End If
End Sub

Function JudgeDate() As Boolean
If Day(Date) > 20 Then
JudgeDate = -1
Else
JudgeDate = 0
End If
End Function

回答No.2

noname#5584

# どのアプリケーションの質問なのかぐらいは最低限書きましょう。
# WordやPowerPointの質問には見えないので、一応、Excelだという前提でコメントします。

以下の手順でできます。

(1) ワークブックを起動し、キーボードの[Alt]キー、[F11]キーを同時に押す。
(2) メニューバーから[挿入] - [標準モジュール]を選択する。
(3) 下記のソースコードをコピペする。

Option Explicit

Public Function GetShimeBi(ByVal Target As Range)
With Application.ActiveSheet
If Trim$(Target.Value) = "○" Then
GetShimeBi = Format$(DateAdd("m", 1, DateAdd("d", -20, Date)), "m月")
Else
GetShimeBi = ""
End If
End With
End Function

(4) ワークシート上で[作業完了]がB列なら、[請求月]の各セルに
=GetShimeBi(B1)
という式を記述すればOKです。(「B1」の「1」は、行番号です)

※ 日付が変わった場合でも、[作業完了]列に変更がなければ、[請求月]は更新されないので問題ありません。

※ WorkSheet_Change イベントプロシージャを使う方法では、「○」が入力されたセルをドラッグして値をコピーした場合に正しく動作しません。

回答No.1

ki-aaa

これを関数でやるのは難しいです。

といいますのは、TODAY()という関数で、今日の日付けを取得できますが、今日このファイルを保存して、明日、同じファイルを開くと、TODAY()の値が変わっているからです。

マクロでならできますが、やりますか。