[[20180403101226]]　『今日の日付から上旬、中旬、下旬で自動表記したい』（わたる）　ページの最後に飛ぶ

『今日の日付から上旬、中旬、下旬で自動表記したい』（わたる）

いつも拝見しており、大変勉強になっております。
現在、仕事での納期表を作成するにあたり、毎度手動で納期日付を記入していましたが自動でできればと思い考えておりましたが、うまくいかずご教授を頂こうと投稿させていただきました次第です。

したいことは、C１から右へ、

 C1	D1	E1	F1	G1	H1	I1	J1	K1	L1	M1	N1	O1
 4/上	4/中	4/下	5/上	5/中	5/下	6/上	6/中	6/下	7/上	7/中	7/下	8/上

このように、本日が4月3日の場合はC1に4/上、D1に4/中と、月を上、中、下の３つで分けたいと思います。
毎月10日までが上旬、11～20日までが中旬、それ以外は下旬としたいです。

よろしくお願いいたします。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

 C1セルに
 =TEXT(TODAY(),"m/"&LOOKUP(DAY(TODAY()),{0,11,21},{"上","中","下"}))

 D1セルに
 =IF(RIGHT(C1,1)="下",MOD(LEFT(C1,LEN(C1)-2),12)+1,LEFT(C1,LEN(C1)-2))&"/"&MID("中下上",FIND(RIGHT(C1,1),"上中下"),1)
 と入力してD1セルを右にフィルコピーではどうか。
（ねむねむ） 2018/04/03(火) 11:10

 こんいちは　＾＾　　ＶＢＡ

 Option Explicit
'**********************************************************
Sub main()
    Dim sh01 As Worksheet, i As Long, j As Long, buf, k As Long, mstr As String
    Dim x As Long
    buf = Array("上", "中", "下")
    Set sh01 = Worksheets("Sheet1")
    i = CInt(Format(Now(), "d"))
    j = CInt(Format(Now(), "m"))
    sh01.Columns(1).ClearContents
    Select Case i
        Case 1 To 10
            mstr = buf(0)
        Case 11 To 20
            mstr = buf(1)
        Case 21 To 31
            mstr = buf(2)
        Case Else
            mstr = "ERROR"
    End Select
    For x = 0 To UBound(buf)
        If buf(x) = mstr Then k = x
    Next
    For x = 1 To 13
        sh01.Cells(1, x + 2) = j & "/" & buf(k)
        If buf(k) = "下" Then
            j = j + 1
        End If
        k = k + 1
        If k > 2 Then k = 0
        i = i + 1
    Next
 End Sub
（隠居じーさん） 2018/04/03(火) 11:39

ねむねむ様

素晴らしいです。
大変助かりました。ありがとうございます。

隠居じーさん　様

VBAでもできるのですね、一度試してみます（＾＾）

本当にありがとうございました。
（わたる） 2018/04/03(火) 11:43

 隠居じーさんさん
 12月の次が13月になってしまっている。
（ねむねむ） 2018/04/03(火) 11:46

 あ～ぁ！そぉ～ですね　＾＾；

 ねむねむ　さん　フォローありがとうございます。

 最後のi=i+1もいらないですしね。考えがたりませんでした。
デートシリアルなんか使うか、条件しきで12越えたら1とか
しないといけないですね。

  と云う事で
私の案は没にしてください。(;^_^A
<< _ _ >>

 わたる　さん
 すみません。

（隠居じーさん） 2018/04/03(火) 11:56

 いちおう、修正版です。　＾＾
でわ
m(__)m

 Option Explicit
'**********************************************************
Sub main()
    Dim sh01 As Worksheet, i As Long, j As Long, buf, k As Long, mstr As String
    Dim x As Long
    buf = Array("上", "中", "下")
    Set sh01 = Worksheets("Sheet1")
    i = CInt(Format(Now(), "d"))
    j = CInt(Format(Now(), "m"))
    sh01.Columns(1).ClearContents
    Select Case i
        Case 1 To 10
            mstr = buf(0)
        Case 11 To 20
            mstr = buf(1)
        Case 21 To 31
            mstr = buf(2)
    End Select
    For x = 0 To UBound(buf)
        If buf(x) = mstr Then k = x
    Next
    For x = 1 To 13
        sh01.Cells(1, x + 2) = j & "/" & buf(k)
        If buf(k) = "下" Then
            j = j + 1
            If j > 12 Then
                j = 1
            End If
        End If
        k = k + 1
        If k > 2 Then k = 0
    Next
 End Sub

（隠居じーさん） 2018/04/03(火) 12:29

コメント返信：

[ 一覧(最新更新順) ]

[[20180403101226]] 『今日の日付から上旬、中旬、下旬で自動表記したい』（わたる） ページの最後に飛ぶ

[[20180403101226]]　『今日の日付から上旬、中旬、下旬で自動表記したい』（わたる）　ページの最後に飛ぶ