Excel VBA質問箱 IV

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

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


51682 / 76738 ←次へ | 前へ→

【29918】Re:21〜20日のサイクルの処理について
回答  Hirofumi  - 05/10/16(日) 14:49 -

引用なし
パスワード
   何を目的として作った物か?、またどんなデータが入るかが善く解らないので
間違って居たらゴメンなさい

  Dim dt1   As Date
  Dim dt2   As Date
  
  'dt1に日付を取得
  dt1 = Cells(4, 4).Value
  'dt2にdt1の値をコピー
  dt2 = dt1
  'もし、dt1の日付が20日を超えるなら
  If Day(dt1) > 20 Then
    'dt2にCells(4, 4)の翌月の同日の日付を設定
    dt2 = DateSerial(Year(dt1), Month(dt1) + 1, Day(dt1))
    'もしCells(4, 4)のとdt2が同日で無いなら同月、同日なら翌月の同日日付を設定
    '?Clngが無意味のでは無く、上記行で、dt1、dt2共同日としているので
    '「CLng(Day(dt1) <> Day(dt2))」は常に「-1」と成る為、
    'dt2 = DateSerial(Year(dt2), Month(dt2) - 1, Day(dt2))としても同じ?
    '意味は、dt1とdt2が常に同年、同月、同日と成ります
    dt2 = DateSerial(Year(dt2), Month(dt2) + CLng(Day(dt1) <> Day(dt2)), Day(dt2))
  End If
  '結論として、「dt1 = Cells(4, 4).Value」〜「End If」までを
  'dt2 = Cells(4, 4).Valueの1行に置き換えても同じ様な結果に成る気がします?

   On Error Resume Next
  ActiveWorkbook.SaveAs FileName:= _
   "U:\AAA" & Format(dt2, "e-m") & "月分\BB明細表" & _
   Format(Date, "mm-dd") & ".xls"
  On Error GoTo 0

検証として、以下の様なユーザー定義関数にしてテストします

Public Function Sample(dt1 As Variant) As Variant

'  Dim dt1   As Date
  Dim dt2   As Date
  
'  dt1 = Cells(4, 4).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

  Sample = dt2
  
End Function

シートのA1から下に適当に20日を跨ぐ様に日付を入れます
B1に「=Sample(A1)」と入れ、日付と同じ行までコピーします

尚、「CLng(Day(dt1) <> Day(dt2))」は何を行っているかと言うと
「Day(dt1) <> Day(dt2)」の部分は、当然、値が「Day(dt1) = Day(dt2)」ならFalseが返り、
「Day(dt1) <> Day(dt2)」ならTrueが返ります
此れを、CLngでキャストすると、CLng(True)は-1を、CLng(False)は0を返します

0 hits

【29915】21〜20日のサイクルの処理について Mi 05/10/16(日) 13:58 質問
【29917】Re:21〜20日のサイクルの処理について かみちゃん 05/10/16(日) 14:15 発言
【29927】Re:21〜20日のサイクルの処理について Hirofumi 05/10/16(日) 17:32 発言
【29918】Re:21〜20日のサイクルの処理について Hirofumi 05/10/16(日) 14:49 回答
【29920】Re:21〜20日のサイクルの処理について Hirofumi 05/10/16(日) 15:30 回答
【29921】Re:21〜20日のサイクルの処理について Hirofumi 05/10/16(日) 15:40 回答
【29923】Re:21〜20日のサイクルの処理について Hirofumi 05/10/16(日) 15:55 回答
【29930】Re:21〜20日のサイクルの処理について Mi 05/10/16(日) 19:23 お礼

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