Заполните дату (jj / mm / yyyy) только путем ввода дня (jj) - PullRequest
Новая
       21

Заполните дату (jj / mm / yyyy) только путем ввода дня (jj)

0 голосов
/ 19 марта 2019

У меня есть 12 листов на 12 месяцев со случайными ежемесячными датами, которые необходимо ввести вручную в столбце A. Давайте рассмотрим январь в качестве примера:

Когда я ввожу число 25 в ячейке A1, я хочу, чтобы ячейка автоматически возвращала 25/01/2019 в A1 (!) (Или 25.01.2009, как вылайк).Насколько мне известно, функции автозаполнения Excel не могут сделать это даже с пользовательскими настройками, поэтому я думаю: VBA?

Я думаю, что код должен выглядеть примерно так (с событием изменения): 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, cell As Range
    Set rng = Range("A:A")
    If Not Application.Intersect(rng, Range(Target.Address)) _
           Is Nothing Then

           '???
           'If cell entered in range is a number Then
           'change value to "number" & "/01/2019" 

    End If
End Sub

Вот где я нахожусь.Я уверен, что это может быть полезным фрагментом кода для людей, работающих с месяцем и вводящих много дат.Я далек от истины?Это вообще выполнимо?Я понимаю, что это может быть сложнее, чем кажется.

Ответы [ 2 ]

1 голос
/ 19 марта 2019

Попробуйте 

If Target.value2 > 0 and Target.value2 <= 31 Then
   Target.Value2 = dateSerial(year(now), month(now), Target.Value2)
End If
0 голосов
/ 19 марта 2019 
Option Explicit    

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim AffectedRange As Range
    Set AffectedRange = Application.Intersect(Me.Range("A:A"), Target)

    If Not AffectedRange Is Nothing Then
        Dim Cell As Range
        For Each Cell In AffectedRange.Cells
            If Cell.Value >= 1 And Cell.Value <= 31 Then
                Application.EnableEvents = False
                Cell.Value = DateSerial(2019, 1, Cell.Value)
                Cell.NumberFormat = "YYYY-MM-DD"
                Application.EnableEvents = True
            End If
        Next Cell
    End If
End Sub
...