Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


10551 / 13644 ツリー ←次へ | 前へ→

【20830】フォルダー(該当月21日〜翌月20日サイクル)のファイル作成について YN61 04/12/21(火) 19:12 質問[未読]
【20832】Re:フォルダー(該当月21日〜翌月20日サイ... Asaki 04/12/21(火) 20:32 回答[未読]
【20833】Re:フォルダー(該当月21日〜翌月20日サイ... Hirofumi 04/12/21(火) 20:37 回答[未読]
【20836】Re:フォルダー(該当月21日〜翌月20日サイ... Asaki 04/12/21(火) 21:25 回答[未読]
【20837】Re:フォルダー(該当月21日〜翌月20日サイ... Asaki 04/12/21(火) 21:49 発言[未読]
【20838】Re:フォルダー(該当月21日〜翌月20日サイ... YN61 04/12/21(火) 22:39 質問[未読]
【20840】Re:フォルダー(該当月21日〜翌月20日サイ... YN61 04/12/21(火) 23:41 質問[未読]
【20841】Re:フォルダー(該当月21日〜翌月20日サイ... かみちゃん 04/12/22(水) 0:30 発言[未読]
【20842】Re:フォルダー(該当月21日〜翌月20日サイ... YN61 04/12/22(水) 7:16 質問[未読]
【20843】Re:フォルダー(該当月21日〜翌月20日サイ... Asaki 04/12/22(水) 9:20 回答[未読]
【20851】Re:フォルダー(該当月21日〜翌月20日サイ... YN61 04/12/22(水) 19:29 お礼[未読]
【20906】Re:フォルダー(該当月21日〜翌月20日サイ... Asaki 04/12/24(金) 9:45 回答[未読]
【20939】Re:フォルダー(該当月21日〜翌月20日サイ... YN61 04/12/26(日) 20:52 質問[未読]
【20943】Re:フォルダー(該当月21日〜翌月20日サイ... Asaki 04/12/27(月) 10:00 回答[未読]
【20951】Re:フォルダー(該当月21日〜翌月20日サイ... YN61 04/12/27(月) 20:00 お礼[未読]
【20953】Re:フォルダー(該当月21日〜翌月20日サイ... Asaki 04/12/28(火) 9:32 回答[未読]
【20959】Re:フォルダー(該当月21日〜翌月20日サイ... YN61 04/12/28(火) 21:02 お礼[未読]
【20969】Re:フォルダー(該当月21日〜翌月20日サイ... Asaki 04/12/29(水) 11:11 発言[未読]
【21135】Re:フォルダー(該当月21日〜翌月20日サイ... YN61 05/1/12(水) 18:31 質問[未読]
【21144】Re:フォルダー(該当月21日〜翌月20日サイ... かみちゃん 05/1/13(木) 6:44 回答[未読]
【21178】Re:フォルダー(該当月21日〜翌月20日サイ... YN61 05/1/13(木) 20:48 お礼[未読]

【20830】フォルダー(該当月21日〜翌月20日サイク...
質問  YN61  - 04/12/21(火) 19:12 -

引用なし
パスワード
   該当月21日〜翌月20日までを1ケ月サイクルで日計をフォルダー(例えば12月は・・・「明細表16−12月分」)に格納しています。
フォルダー作成は21日に自動で作成(Auto_Open)させています。

12月21日には、「明細表17−01月分」のフォルダーに「明細表01-21」のファイルに仕上げたいのですが、ファイルがフォルダーの中に入らず、エラーになります。
コードの問題点をご指摘のほどお願いします。
(今年の12月20日までは問題なくファイルの保存が出来ましたが、今日12月21日にはエラーになりました、ご教授の程お願いいたします)

   If Format(Date, "d") > 20 Then
   ActiveWorkbook.SaveAs Filename:= _
   "U:\フォルダーA\明細表" & Format(Date, "yy") + 12 _
    & "-" & Format(Date, "m") + 1 & "月分\明細表" _
    & Format(Date, "mm" & "-" & "dd")
   
   If Format(Date, "m") = 12 Then
   ActiveWorkbook.SaveAs Filename:= _
   "U:\フォルダーA\明細表" & Format(Date, "yy") + 13 _
    & "-" & Format(Date, "m") - 11 & "月分\明細表" _
    & Format(Date, "mm" & "-" & "dd")
   
   End If
    
   Else
   ActiveWorkbook.SaveAs Filename:= _
   "U:\フォルダーA\明細表" & Format(Date, "yy") + 12 _
    & "-" & Format(Date, "m") & "月分\明細表" _
    & Format(Date, "mm" & "-" & "dd")
  
   End If

【20832】Re:フォルダー(該当月21日〜翌月20日サ...
回答  Asaki  - 04/12/21(火) 20:32 -

引用なし
パスワード
   こんばんは。

新規シートを追加して、A1セルに適当な日付を入力して↓を実行してみてください。
Sub test()
  Dim dt   As Date

  dt = Cells(1, 1).Value
  If Day(dt) > 20 Then
    dt = DateSerial(Year(dt), Month(dt) + 1, Day(dt))
  End If
  
  MsgBox "明細表" & Format(dt, "e-mm") & "月分\明細表" & Format(dt, "mm-dd")
End Sub

【20833】Re:フォルダー(該当月21日〜翌月20日サ...
回答  Hirofumi  - 04/12/21(火) 20:37 -

引用なし
パスワード
   >12月21日には、「明細表17−01月分」のフォルダーに「明細表01-21」
>のファイルに仕上げたいのですが、ファイルがフォルダーの中に入らず、
>エラーになります。
>コードの問題点をご指摘のほどお願いします。
>(今年の12月20日までは問題なくファイルの保存が出来ましたが、
>今日12月21日にはエラーになりました、ご教授の程お願いいたします)

このコードでは、12月21日には、「明細表01-21」では無く、「明細表12-21」のファイルが、
「明細表17−01月分」では無く、「明細表17-1月分」のフォルダに格納される様に成っていますが?

以下のコードを実行して見て下さい、
ActiveSheetに、2004年1月から翌年1月までの20日、21日のファイル名が出力されます

Public Sub Test()
  
  Dim i As Long
  Dim j As Long
  Dim strFileName As String
  Dim dtmDate As Date
  Dim lngRow As Long
  
  lngRow = 1
  For i = 1 To 13
    For j = 20 To 21
      dtmDate = DateSerial(2004, i, j)
      If Format(dtmDate, "d") > 20 Then
        strFileName = "U:\フォルダーA\明細表" _
                & Format(dtmDate, "yy") + 12 & "-" _
                & Format(dtmDate, "m") + 1 _
                & "月分\明細表" _
                & Format(dtmDate, "mm" & "-" & "dd")
        If Format(dtmDate, "m") = 12 Then
          strFileName = "U:\フォルダーA\明細表" _
                  & Format(dtmDate, "yy") + 13 & "-" _
                  & Format(dtmDate, "m") - 11 _
                  & "月分\明細表" _
                  & Format(dtmDate, "mm" & "-" & "dd")
        End If
      Else
        strFileName = "U:\フォルダーA\明細表" _
                & Format(dtmDate, "yy") + 12 & "-" _
                & Format(dtmDate, "m") _
                & "月分\明細表" _
                & Format(dtmDate, "mm" & "-" & "dd")
      End If
      With ActiveSheet
        .Cells(lngRow, "A").Value = dtmDate
        .Cells(lngRow, "B").Value = strFileName
      End With
      lngRow = lngRow + 1
    Next j
    lngRow = lngRow + 1
  Next i

End Sub

【20836】Re:フォルダー(該当月21日〜翌月20日サ...
回答  Asaki  - 04/12/21(火) 21:25 -

引用なし
パスワード
   ごめんなさい。
さっきのでは、ダメそうです。
A1に色々な日付を入力して実行してみてください。

Sub test()
  Dim dt1   As Date
  Dim dt2   As Date
  Dim nen   As String
  Dim tsuki  As String
  Dim hi   As String

  dt1 = Cells(1, 1).Value
  hi = Format(dt1, "dd")
  If Day(dt1) > 20 Then
    dt2 = DateSerial(Year(dt1), Month(dt1) + 1, Day(dt1))
    nen = Format(dt2, "e")
    tsuki = Right("0" & Month(dt2) + CLng(Day(dt1) <> Day(dt2)), 2)
  Else
    nen = Format(dt1, "e")
    tsuki = Format(dt1, "mm")
  End If
 
  MsgBox "明細表" & nen & "-" & tsuki & "月分\明細表" & tsuki & "-" & hi
End Sub

【20837】Re:フォルダー(該当月21日〜翌月20日サ...
発言  Asaki  - 04/12/21(火) 21:49 -

引用なし
パスワード
   更に訂正。

A1に色々な日付を入力して実行してみてください。

Sub test()
  Dim dt1   As Date
  Dim dt2   As Date

  dt1 = Cells(1, 1).Value
  dt2 = dt1
  If Day(dt1) > 20 Then
    dt2 = DateSerial(Year(dt1), Month(dt1) + 1, Day(dt1))
    dt2 = DateSerial(Year(dt2), Month(dt2) + CLng(Day(dt1) <> Day(dt2)), Day(dt2))
  End If

  MsgBox "明細表" & Format(dt2, "e-mm") & "月分\明細表" & Format(dt2, "mm") & "-" & Format(dt1, "dd")
End Sub

【20838】Re:フォルダー(該当月21日〜翌月20日サ...
質問  YN61  - 04/12/21(火) 22:39 -

引用なし
パスワード
   ▼Asaki さん:
こんばんは。

いつもありがとうございます。シュミレーションのサンプルを漬けていただき、
よく分かりました。これで21から20日までのサイクルの処理の仕方が
よく分かりました。ありがとうございます。実際にフォルダーに各種ファイルを
格納できる事も分かりました。貴殿の書いていただいてコードで、元号が変わらない
限り、ず〜っと使用できると理解しても良いのですね。

もう一つ教えていただきたいのですが。・・・フォルダーを自動で作って発生させていました。順調に動いていたのですが、これも12月21日にトラブルが出て、手動でフォルダーを作って免れています。自動のコードもチェックいただけませんでしょうか。
よろしくお願いします。

素晴らしいコードが書かれていて、本当に感謝感激です。
test()
>  Dim dt As Date
>
>  dt = Cells(1, 1).Value
>  If Day(dt) > 20 Then
>    dt = DateSerial(Year(dt), Month(dt) + 1, Day(dt))
>  End If
>  
>  MsgBox "明細表" & Format(dt, "e-mm") & "月分\明細表" & Format(dt, "mm-dd")
>End Sub


ここからが自動のコードですチェックをお願いします。
Sub Auto_Open()

 ' 自動発生(20日を過ぎた時点で翌月分ホルダー作成)
  Dim CkM As Integer
  Const PFol As String = "U:\AA\"

  If Day(Date) > 20 Then
   CkM = Month(DateAdd("m", 1, Date))
  Else
   CkM = Month(Date)
  End If

  If Dir(PFol & "明細表" & Format(Date, "yy") + 12 & "-" & _
    CkM & "月分", 16) = "" Then

   MkDir PFol & "明細表" & Format(Date, "yy") + 12 & "-" & _
    CkM & "月分"

   MsgBox " 「こんにちは」 新しい月が始まりました !" & Chr(10) & _
   "    当月のフォルダー" & Chr(10) & _
   "「明細表" & Format(Date, "yy") + 12 & "-" & CkM & "月分」" & _
   "を作成しました !", 64

  End If

End Sub

【20840】Re:フォルダー(該当月21日〜翌月20日サ...
質問  YN61  - 04/12/21(火) 23:41 -

引用なし
パスワード
   ▼Asaki さん:
>こんばんは。
>
>新規シートを追加して、A1セルに適当な日付を入力して↓を実行してみてください。
>Sub test()
>  Dim dt   As Date
>
>  dt = Cells(1, 1).Value
>  If Day(dt) > 20 Then
>    dt = DateSerial(Year(dt), Month(dt) + 1, Day(dt))
>  End If
>  
>  MsgBox "明細表" & Format(dt, "e-mm") & "月分\明細表" & Format(dt, "mm-dd")
>End Sub

例えば2005/1/21と入れてマクロをすると「明細票16−2月分¥明細票02−21」になります→何とか「・・・¥明細票01−21」と出したいのですが・・・
どのようにすると良いのでしょうか教えてください。
Format(dt,"mm-dd")を→Format(Date,"mm-dd")
にすると良いのでしょうか・・・・・?????

【20841】Re:フォルダー(該当月21日〜翌月20日サ...
発言  かみちゃん  - 04/12/22(水) 0:30 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>例えば2005/1/21と入れてマクロをすると「明細票16−2月分¥明細票02−21」になります→何とか「・・・¥明細票01−21」と出したいのですが・・・

よく読んでないので、勘違いしているかもしれませんが、
-----
12月21日には、「明細表17−01月分」のフォルダーに「明細表01-21」のファイルに仕上げたい
-----
ということからすると、

2004/12/21の場合は、明細表17-01月分\明細表01-21.xls
2005/1/21の場合は、明細表17-02月分\明細表02-21.xls
となるべきで、
2005/1/21の場合は、明細表17-02月分\明細表01-21.xls
としてはいけないのではないでしょうか?

【20842】Re:フォルダー(該当月21日〜翌月20日サ...
質問  YN61  - 04/12/22(水) 7:16 -

引用なし
パスワード
   ▼かみちゃん さん:
>こんにちは。かみちゃん です。
>
>>例えば2005/1/21と入れてマクロをすると「明細票16−2月分¥明細票02−21」になります→何とか「・・・¥明細票01−21」と出したいのですが・・・
>
>よく読んでないので、勘違いしているかもしれませんが、
>-----
>12月21日には、「明細表17−01月分」のフォルダーに「明細表01-21」のファイルに仕上げたい
>-----
>ということからすると、
>
>2004/12/21の場合は、明細表17-01月分\明細表01-21.xls
>2005/1/21の場合は、明細表17-02月分\明細表02-21.xls
>となるべきで、
>2005/1/21の場合は、明細表17-02月分\明細表01-21.xls
>としてはいけないのではないでしょうか?

いつもご指導ありがとうございます。
毎日の集計ファイルは当日の日にちになれば良いのですが。
ただ、月の初めが21〜20日を月のサイクルとしていますので、
2005/1/21は・・・明細票17-2月分(フォルダ)に明細票01-21が
格納されれば良いのですが・・・このコードで宜しいですね
ありがとうございます。
また、別件の質問は、改めて仕切りなおして、整理して聞かせて
いただきたく存じますので、よろしくご指導ください。

【20843】Re:フォルダー(該当月21日〜翌月20日サ...
回答  Asaki  - 04/12/22(水) 9:20 -

引用なし
パスワード
   時間的に、一番最後のやつを使ってください。
少なくとも、1番最初のやつは上手く行きませんから。(元の日付が1/31の場合など)

Sub test()
  Dim dt1   As Date
  Dim dt2   As Date

  dt1 = Cells(1, 1).Value
  dt2 = dt1
  If Day(dt1) > 20 Then
    dt2 = DateSerial(Year(dt1), Month(dt1) + 1, Day(dt1))
    dt2 = DateSerial(Year(dt2), Month(dt2) + CLng(Day(dt1) <> Day(dt2)), Day(dt2))
  End If

  MsgBox "明細表" & Format(dt2, "e-mm") & "月分\明細表" & Format(dt2, "mm") & "-" & Format(dt1, "dd")
End Sub

かみちゃん さんもおっしゃってますが
一番最初の
>12月21日には、「明細表17−01月分」のフォルダーに「明細表01-21」のファイルに仕上げたい

>2005/1/21と入れてマクロをすると「明細票16−2月分¥明細票02−21」になります
>→何とか「・・・¥明細票01−21」と出したいのですが・・・
では、内容が違います。
後者でよいですね?
つまり、12/21 は「明細票17-01月分」フォルダに「明細票12-21」のファイルが作成される。
これであれば
  MsgBox "明細表" & Format(dt2, "e-mm") & "月分\明細表" & Format(dt1, "mm") & "-" & Format(dt1, "dd")
にしてください。


フォルダを作成する方は↓のような感じでどうですか?
Sub Auto_Open()

 ' 自動発生(20日を過ぎた時点で翌月分ホルダー作成)
  Dim str   As String
  Dim dt   As Date
  Const PFol As String = "U:\AA\"

  '20日を過ぎていたら1ヶ月加算
  If Day(Date) > 20 Then
    dt = DateAdd("m", 1, Date)
  Else
    dt = Date
  End If

  str = PFol & "明細表" & Format(dt, "e-mm") & "月分"
  If Dir(str, vbDirectory) = "" Then
    MkDir str
    MsgBox " 「こんにちは」 新しい月が始まりました !" & vbLf & _
      "    当月のフォルダー" & vbLf & Replace(str, PFol, "") & "を作成しました !" _
      , vbOKOnly + vbInformation
  End If

End Sub

【20851】Re:フォルダー(該当月21日〜翌月20日サ...
お礼  YN61  - 04/12/22(水) 19:29 -

引用なし
パスワード
   ▼Asaki さん:

ご親切なご指導ありがとうございました。
貴重な時間を裂いていただき、本当に感謝しています。
またフォルダーの作成までお願いして、本当に申し訳ありませんでした。
このフォルダー作成のレベルになると理解が少し厳しいです。徐々に勉強して行きますので、今後ともよろしくお願いします。


>時間的に、一番最後のやつを使ってください。
>少なくとも、1番最初のやつは上手く行きませんから。(元の日付が1/31の場合など)

早速一番最初のご提示いただいたものを今日、使わせていただきましたが、問題なく、動いています。素晴らしい!の感激の一言ですが・・・問題あるでしょうか?

Sub test1()
 Dim dt As Date

 dt = Cells(1, 1).Value
 If Day(dt) > 20 Then
    dt = DateSerial(Year(dt), Month(dt) + 1, Day(dt))
 End If
 
 MsgBox "明細表" & Format(dt, "e-m") & "月分\明細表" & _
 Format(Date, "mm-dd") & ".xls"  
End Sub

下から2行目を「Format(Date,"mm-dd")」
で問題なさそうに思いますが、また思い通りに動いて・展開していますが。・・・

→元の日付が1/31の場合など、上手く行かないとのご指摘をいただいていますが、上手くいってるようですが、どのような意味でしょうか?

一番最後のコードも残しておきます。万が一、最初のもの(上のコードですが)がトラブル(トラブルと思いませんが)が発生したときに、代用するようにします。


>
>かみちゃん さんもおっしゃってますが
>12月21日には、「明細表17−01月分」のフォルダーに「明細表01-21」のファイルに仕上げたい

→これは、「明細表17−1月分」のフォルダーには
「明細表12-21」から「明細表01-20」までファイル(毎日作成するデータですが)が格納される事を意味しています。

集計したファイルを、フォルダーに格納する仕事がルーティーンのワークになっています。もし、問題が発生しましたら、また質問をさせていただくかと思います。
これからも、よろしくお願いします。

【20906】Re:フォルダー(該当月21日〜翌月20日サ...
回答  Asaki  - 04/12/24(金) 9:45 -

引用なし
パスワード
   >早速一番最初のご提示いただいたものを今日、使わせていただきましたが、
>問題なく、動いています。素晴らしい!の感激の一言ですが・・・問題あるでしょうか?
>→元の日付が1/31の場合など、上手く行かないとのご指摘をいただいていますが、
>上手くいってるようですが、どのような意味でしょうか?

問題があるから、最後のやつを使ってくださいとお願いしています。
A1に 1/31 と入力してtest1を実行したら、フォルダが3月分になるでしょう?
2月分 にならなければいけませんよね?

>一番最後のコードも残しておきます。万が一、最初のもの(上のコードですが)が
>トラブル(トラブルと思いませんが)が発生したときに、代用するようにします。
きちんと動かないと分かっていますから、最初のコードは使わないでください。

>>12月21日には、「明細表17−01月分」のフォルダーに「明細表01-21」のファイルに仕上げたい
>→これは、「明細表17−1月分」のフォルダーには
>「明細表12-21」から「明細表01-20」までファイル(毎日作成するデータですが)が格納される事を意味しています。
内容は分かっていますが、ご自分の記述内容が食い違っていることにお気づきでは有りませんか?

動作確認して、作成されるフォルダ名、ファイル名が本当に正しいかどうか(意図どおりか)再度チェックされることをお勧めします。

【20939】Re:フォルダー(該当月21日〜翌月20日サ...
質問  YN61  - 04/12/26(日) 20:52 -

引用なし
パスワード
   ▼Asaki さん:
>問題があるから、最後のやつを使ってくださいとお願いしています。
>A1に 1/31 と入力してtest1を実行したら、フォルダが3月分になるでしょう?
>2月分 にならなければいけませんよね?

確かに1/31と入力すると→「3月分」ホルダーになりました。一番最後のものを使わせせていただきます。
ただ、今日(12月26日)の処理をしますと

フォルダーは「1月分」で良いのですが、ファイル名が「明細表12ー26」で無いと
困るのですが、・・・このコードでは「明細表01−26」になります。

この件に関しましては、前回にも書かせていますが、最後のコードでは1月先の月日に
なるのですが・・・何処が問題なのでしょうか

(前回の質問の中で)
>>>12月21日には、「明細表17−01月分」のフォルダーに「明細表01-21」のファイルに仕上げたい
>>→これは、「明細表17−1月分」のフォルダーには
>>「明細表12-21」から「明細表01-20」までファイル(毎日作成するデータですが)が格納される事を意味しています。

>内容は分かっていますが、ご自分の記述内容が食い違っていることにお気づきでは有り
>ませんか?

>動作確認して、作成されるフォルダ名、ファイル名が本当に正しいかどうか(意図どお
>りか)再度チェックされることをお勧めします。

どのような意味なのか少し分かりにくいのですが、
1月分のフォルダーには・・・→「12月21日から1月20日」までのファイルが入る必要があります。最後にいただいたコードを動かすと「明細表17-01月分\明細票01-26」となります。
これでは無く「明細表17-01月分\明細票12-26」とならないとだめなんです。

最後に再度、今日の日にちがファイルに入る方法を教えていただきますよう、
お願い申し上げます。下のコードでよいでしょうか?
本当にご親切にありがとうございました、会社に行って直します。
ありがとうございます。

Sub test2()
  Dim dt1   As Date
  Dim dt2   As Date

  dt1 = Cells(1, 1).Value
  dt2 = dt1
  If Day(dt1) > 20 Then
    dt2 = DateSerial(Year(dt1), Month(dt1) + 1, Day(dt1))
    dt2 = DateSerial(Year(dt2), Month(dt2) + CLng(Day(dt1) <> Day(dt2)), Day(dt2))
  End If

  MsgBox "明細表" & Format(dt2, "e-m") & "月分\明細表" & _
  Format(Date, "mm-dd") & ".xls"

  '  Format(dt2, "mm") & "-" & Format(dt1, "dd")・・・これを上のコードと入  れ替えました
End Sub

【20943】Re:フォルダー(該当月21日〜翌月20日サ...
回答  Asaki  - 04/12/27(月) 10:00 -

引用なし
パスワード
   >1月分のフォルダーには・・・→「12月21日から1月20日」までのファイルが入る必要があります。
>最後にいただいたコードを動かすと「明細表17-01月分\明細票01-26」となります。
>これでは無く「明細表17-01月分\明細票12-26」とならないとだめなんです。
再三書いていますが、一番最初に書き込みされた仕様なら、↑になるのです。
「最後のコード」といっている 04/12/21(火) 21:49 の書き込み時点では、
>12月21日には、「明細表17−01月分」のフォルダーに「明細表01-21」のファイルに仕上げたいのですが
という仕様でした。

この件は、04/12/22(水) 9:20 の書き込みで
>MsgBox "明細表" & Format(dt2, "e-mm") & "月分\明細表" & Format(dt1, "mm") & "-" & Format(dt1, "dd")
>にしてください。
と訂正していますので、これなら上手く良くと思いますが、もうちょっと修正して

MsgBox "明細表" & Format(dt2, "e-mm") & "月分\明細表" & Format(dt1, "mm-dd")
でどうでしょうか。

勿論、
MsgBox "明細表" & Format(dt2, "e-m") & "月分\明細表" & _
  Format(Date, "mm-dd") & ".xls"
でもかまいません。

【20951】Re:フォルダー(該当月21日〜翌月20日サ...
お礼  YN61  - 04/12/27(月) 20:00 -

引用なし
パスワード
   ▼Asaki さん:

ありがとうございました。
Asaki様のご指示よく理解できました。
後一つ教えてください・・・Asaki様の書いていただいた、このコードの理解をしたいのですがコメントいただけませんでしょうか


If Day(dt1) > 20 Then
    dt2 = DateSerial(Year(dt1), Month(dt1) + 1, Day(dt1))
    dt2 = DateSerial(Year(dt2), Month(dt2) + CLng(Day(dt1) <> Day(dt2)), Day(dt2))

End If

【20953】Re:フォルダー(該当月21日〜翌月20日サ...
回答  Asaki  - 04/12/28(火) 9:32 -

引用なし
パスワード
   コメント付けてみます。

'今日の日にちが21日以降なら翌月を計算
If Day(dt1) > 20 Then
  'ひと月加算した日付をdt2に代入
  dt2 = DateSerial(Year(dt1), Month(dt1) + 1, Day(dt1))
  '今日の日にちと、ひと月後の日にちが違っていれば、更に次の月になっているので補正
  '-- Day(dt1) <> Day(dt2) 成立時はLong型に変換すると -1/ 不成立で 0 となることを利用
  dt2 = DateSerial(Year(dt2), Month(dt2) + CLng(Day(dt1) <> Day(dt2)), Day(dt2))
End If

ひと月後のほうは、日にちは利用しないため、単純に1日を利用して
If Day(dt1) > 20 Then
  dt2 = DateSerial(Year(dt1), Month(dt1) + 1, 1)
End If
でも充分ですね。

【20959】Re:フォルダー(該当月21日〜翌月20日サ...
お礼  YN61  - 04/12/28(火) 21:02 -

引用なし
パスワード
   ▼Asaki さん:

コメントを付けていただきありがとうございました。
何から何までご指導いただきありがとうございます。

まだ、CLng関数の使い方が分かりませんので、十分な理解までに
至っていませんが、これからまた勉強させていただきます。


>  '-- Day(dt1) <> Day(dt2) 成立時はLong型に変換すると -1/ 不成立で 0 とな
>ることを利用
・・・このあたりが未だ理解できておりません。

今後ともよろしくお願いいたします。御礼申し上げます。

【20969】Re:フォルダー(該当月21日〜翌月20日サ...
発言  Asaki  - 04/12/29(水) 11:11 -

引用なし
パスワード
   >dt2 = DateSerial(Year(dt2), Month(dt2) + CLng(Day(dt1) <> Day(dt2)), Day(dt2))
もうちょっと分かりやすく書くと↓のようになります。
If Day(dt1) <> Day(dt2) Then
  dt2 = DateSerial(Year(dt2), Month(dt2) - 1, Day(dt2))
End If

例えば、1/31のひと月後は
>dt2 = DateSerial(Year(dt1), Month(dt1) + 1, Day(dt1))
で計算すると、勝手に(気を利かせて?) 3/2 となります。
このような場合は、月の部分だけを見ると、ふた月後になっていますから、
月の部分を再度 -1 してやらなければ正しい結果が得られません。
このような現象が起こる場合は、必ず
Day(dt1) <> Day(dt2) … 今の例なら 31 <> 2
が成立しますから(↑の式が True になる)、これをLong型に変換して
CLng(Day(dt1) <> Day(dt2)) = -1
よって、元の日付と変換後の日付の日にちの部分が異なる場合は、月の部分を -1 する
という意味になります。

ちなみに、12/31 の ひと月後は、正しく 1/31 と算出されますから、-1 するのに年またぎの考慮は不要です。


このような書き方は、ある種のテクニックと考えてよいと思いますが、
↓のようなサンプルで、少しは理解の助けになるでしょうか?
(エラー処理していません)
Sub ex1()
  Dim a      As Long
  Dim b      As Long
  a = Application.InputBox("整数を入力してください", "変数 a を決定", Type:=1)
  b = Application.InputBox("整数を入力してください", "変数 b を決定", Type:=1)
  MsgBox "a = b ?" & vbCrLf & (a = b) & " --> " & CLng(a = b)
End Sub

【21135】Re:フォルダー(該当月21日〜翌月20日サ...
質問  YN61  - 05/1/12(水) 18:31 -

引用なし
パスワード
   ▼Asaki さん:

丁寧なコードのコメントありがとうございました。
Dateserialの表現とCLngの使い方についてほぼ理解できました。
ご返答いただき直ぐに御礼を、っと思っていましたが、理解が出来ず
直ぐに御礼の返事が出来ませんでした。
このような書き方は、ある種のテクニックとご指摘いただいたことを思い出します。

また、すばらしいサンプルの理解も徐々に分かってきました。
あと、「vbCrLf」の意味が分かりません。又機会がありましたら
教えて下さい。
Dim a      As Long
Dim b      As Long
 a = Application.InputBox("整数を入力してください", "変数 a を決定",Type:=1)
 b = Application.InputBox("整数を入力してください", "変数 b を決定",Type:=1)
  MsgBox "a = b ? " & vbCrLf & (a = b) & " --> " & CLng(a = b)

また、以前にご指導いただいた、21日以降のフォルダーを翌月分にして
作成するコードを頂きましたが、コメントをいただけませんでしょうか
Sub Auto_Open()  '自動発生(20日を過ぎた時点で翌月分ホルダー作成)
  Dim str   As String
  Dim dt   As Date
  Const PFol As String = "U:\明細\"  '・・・・・ここのConstPFolの意味は

  '20日を過ぎていたら1ヶ月加算
  If Day(Date) > 20 Then
    dt = DateAdd("m", 1, Date)
  Else
    dt = Date
  End If

  str = PFol & "明細表" & Format(dt, "e-m") & "月分"
  If Dir(str, vbDirectory) = "" Then  '・・・・ここのコードの意味は
    MkDir str           '・・・・・・MkDirの意味は
    MsgBox " 「こんにちは」 新しい月が始まりました !" & vbLf & _
  " 当月のフォルダー" & vbLf & Replace(str, PFol, "") & "を作成しました !"   _ , vbOKOnly + vbInformation  '・・・ここのコードの意味も分かりません、
  End If

End Sub

本当にありがとうございました。今後ともよろしくご指導いただきますようお願い
致します。

【21144】Re:フォルダー(該当月21日〜翌月20日サ...
回答  かみちゃん  - 05/1/13(木) 6:44 -

引用なし
パスワード
   こんにちは。かみちゃん です。

わからないところは、ヘルプや過去ログは、ご覧になりましたか?

>「vbCrLf」の意味が分かりません。

以下のコードでどう違うか見てみてください。
Sub Macro1()
 MsgBox "あああ" & vbCrLf & "いいい"
 MsgBox "あああ" & "いいい"
End Sub
vbCrLfの意味は、ヘルプを見てください。(vbCrLfという文字の上でF1キーを押す)
また以下のURLも参考になるかもしれません
http://www2.moug.net/cgi-bin/technic.cgi?exvba+TP14010029

>  Const PFol As String = "U:\明細\"  '・・・・・ここのConstPFolの意味

まずは、Constステートメントをヘルプで調べてください。
変数に対して定数(プログラム内で変更できない値)です。

>  If Dir(str, vbDirectory) = "" Then  '・・・・ここのコードの意味は

これについても、Dir関数をヘルプで調べると載っています。
strという名前のフォルダ(vbDirectory)が存在しなかった場合です。

>    MkDir str           '・・・・・・MkDirの意味は

ヘルプに載っています。
MakeDirectoryのことです。

> vbOKOnly + vbInformation  '・・・ここのコードの意味も分かりません、

以下のコードでどう違うか見てみてください。
Sub Macro2()
 MsgBox "あああ"
 MsgBox "あああ" , vbOKOnly
 MsgBox "あああ" , vbInformation
 MsgBox "あああ" , vbOKOnly +  vbInformation
End Sub
「MsgBox 関数の定数」がヘルプに載っています。

【21178】Re:フォルダー(該当月21日〜翌月20日サ...
お礼  YN61  - 05/1/13(木) 20:48 -

引用なし
パスワード
   ▼かみちゃん さん:

今晩は。
いつもありがとうございます。

>わからないところは、ヘルプや過去ログは、ご覧になりましたか?
失礼致しました。

でも、丁寧にご指導ありがとうございました。
サンプルも付けていただき本当に分かりやすく教えていただき感謝しています。
今後ともよろしくお願いいたします。

「vbCrLf」の意味も本当に良く分かりました。
完全に覚える事ができました。今後使ってみようと思います。

ヘルプや過去ログも活用するようにさせていただきます。
ありがとうございました。

10551 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free