Excel VBA質問箱 IV

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

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


34099 / 76738 ←次へ | 前へ→

【47854】Re:入力方法の色々
回答  Hirofumi  - 07/3/24(土) 16:19 -

引用なし
パスワード
   >7/3/20と入力した場合のみH19.03.20と表示させたいのですが
>最初のコードの機能を残したいのですが・・・

元のコードでも、「7/3/20」→「H19.03.20」とは成らないのでは?
元のコードでは、「7/3/20」→「2007/3/20」と成ると思うのですが(Excel97以外では)

>下記のコードで20と入力するとM33.01.20になってしまいます

此れは、IsDateで確認を取っている為、セルの書式が日付に成って居る場合に起こります

>それと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"))
    With 各々のセル
      If .Value <> "" Then
        If IsNumeric(.Value) Or IsDate(.Value) Then
          If 1 <= .Value And .Value <= 31 Then
            lngYear = Year(Date)
            lngMonth = Month(Date)
            lngDay = .Value
          Else
            lngYear = Year(.Value)
            lngMonth = Month(.Value)
            lngDay = Day(.Value)
          End If
          If Day(Date) >= 25 Then
            lngMonth = lngMonth + 1
          End If
          .NumberFormatLocal = "G/標準"
          .Value = Format(DateSerial(lngYear, lngMonth, lngDay), strForm)
        End If
      End If
    End With
  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 お礼

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