Excel VBA質問箱 IV

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

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


34097 / 76732 ←次へ | 前へ→

【47850】Re:入力方法の色々
発言  takashi  - 07/3/24(土) 12:35 -

引用なし
パスワード
   ▼Hirofumi さん:
ありがとうございます。

7/3/20と入力した場合のみH19.03.20と表示させたいのですが
最初のコードの機能を残したいのですが・・・
下記のコードで20と入力するとM33.01.20になってしまいます
それと7/3/20と入力した場合H19.03.21となり1プラスとなりますが
プラス1は不要です。

わかりにくい説明ですみません。
よろしくお願いします。

>実状に合うか、解りませんが?
>要は、シリアル値としてセルに代入せず文字列にすると言う事ですか?
>
>Option Explicit
>
>Private Sub Worksheet_Change(ByVal Target As Range)
>
>  Const strForm As String = "gee.mm.dd"
>  
>  Dim 各々のセル As Range
>  Dim lngYear As Long
>  Dim lngMonth As Long
>  Dim lngDay As Long
>  
>  If Intersect(Target, Range("C28:C500")) Is Nothing Then
>    Exit Sub
>  End If
>
>  Application.EnableEvents = False
>
>  For Each 各々のセル In Intersect(Target, Range("C28:C500"))
>    If 各々のセル.Value2 <> "" Then
>      If IsDate(各々のセル.Value) Then
>        lngYear = Year(各々のセル.Value)
>        lngMonth = Month(各々のセル.Value)
>        lngDay = Day(各々のセル.Value) + 1
                        ↑プラス1を削除すると
                        H19.3.20となりOKです
>      Else
>        If IsNumeric(各々のセル.Value2) Then
>          If 各々のセル.Value2 <= 31 Then
>            lngYear = Year(Date)
>            lngMonth = Month(Date)
>            lngDay = Day(各々のセル.Value2) + 1
>          End If
>        End If
>      End If
>      If Day(Date) >= 25 Then
>        lngMonth = lngMonth + 1
>      End If
>      各々のセル.Value = Format(DateSerial(lngYear, lngMonth, lngDay), strForm)
>    End If
>  Next
>
>  Application.EnableEvents = True
>  
>End Sub

0 hits

【47844】入力方法の色々 takashi 07/3/24(土) 3:19 質問
【47845】Re:入力方法の色々 ウッシ 07/3/24(土) 10:49 発言
【47846】Re:入力方法の色々 takashi 07/3/24(土) 11:05 発言
【47847】Re:入力方法の色々 ウッシ 07/3/24(土) 11:48 発言
【47848】Re:入力方法の色々 Hirofumi 07/3/24(土) 12:17 回答
【47849】Re:入力方法の色々 ウッシ 07/3/24(土) 12:24 発言
【47850】Re:入力方法の色々 takashi 07/3/24(土) 12:35 発言
【47854】Re:入力方法の色々 Hirofumi 07/3/24(土) 16:19 回答
【47873】Re:入力方法の色々 takashi 07/3/25(日) 1:15 お礼

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