Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Заполнение и сохранение текущей даты при заполнении строк таблицы
 
#1
26.07.2017 11:55:23
Добрый день!

Прошу помочь. Пытаюсь переделать следующий код из поста под себя:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Count > 1 Then Exit Sub
        If Intersect(.Cells, Columns(2)) Is Nothing Then Exit Sub
        If Not IsDate(Cells(.Row, 1)) Then Cells(.Row, 1).Value = Date
        If IsEmpty(.Cells) Then Cells(.Row, 1).ClearContents
    End With
End Sub
Файл с примером можно взять по ссылке Пример

Необходимо при внесении данных в столбцы B,C,D и далее... заполнять в столбце A текущую дату, которая бы оставалась фиксированной.
Заполнение даты необходимо так же при заполнении сразу нескольких строк, т.е. в случае вставки данных извне.При использовании кода выше такой возможности нет. Дата проставляется только при построчном заполнении.
В случае изменения\удаления данных из одной, двух и более ячеек строки дата в строке не должна меняться.


Получилось что-то вроде:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Count > 1 Then Exit Sub
        If Intersect(.Cells, Range("B:P")) Is Nothing Then Exit Sub
        If Not IsDate(Cells(.Row, 1)) Then Cells(.Row, 1).Value = Date
    End With
End Sub
Однако даты проставляются только при построчном заполнении.

Заранее спасибо.
 
 
 
#2
26.07.2017 13:00:45
Код
Private Sub Worksheet_Change(ByVal Target As Range)
dim c
 With Target
 If Intersect(.Cells, Range("B:P")) Is Nothing Then Exit Sub
   application.enableevens=0
    for each c in .cells
      If Not IsDate(Cells(c.Row, 1)) Then Cells(c.Row, 1).Value = Date
    next
   application.enableevens=-1
 End With
End Sub
Изменено: kuklp - 26.07.2017 13:02:19
Я сам - дурнее всякого примера! ...
 
 
 
#3
26.07.2017 14:25:00
kuklp, спасибо! Есть небольшой недостаток кода. При любом действии со строками макрос проставляет даты, будь то удаление значений в строках или даже удаление самих строк. Возможно ли как то это обойти?
Например, добавить условие, при котором в случае отсутствия значений в столбцах ("B:P"), столбец A бы очищался?
Изменено: neqkeet - 26.07.2017 14:50:37
 
 
 
#4
27.07.2017 09:51:46
Вопрос все еще актуален, прошу помочь.
 
 
 
#5
27.07.2017 10:05:27
Пример за Вас рисовать никто не хочет. Обленились.
Я сам - дурнее всякого примера! ...
 
 
 
#6
27.07.2017 12:04:41
kuklp, добрее нужно быть  :) .

Пробовал так:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c
 With Target
 If Intersect(.Cells, Range("B:P")) Is Nothing Then Exit Sub
    Application.EnableEvents = 0
    For Each c In .Cells
      If Not IsDate(Cells(c.Row, 1)) Then Cells(c.Row, 1).Value = Date
    If IsEmpty(c.Cells) Then Cells(c.Row, 1).ClearContents
    Next
    Application.EnableEvents = -1
End With
End Sub

Но дата удаляется при редактировании любой ячейки в диапазоне.

Еще так пробовал:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c
 With Target
 If Intersect(.Cells, Range("B:P")) Is Nothing Then Exit Sub
    Application.EnableEvents = 0
    For Each c In .Cells
      If Not IsDate(Cells(c.Row, 1)) Then Cells(c.Row, 1).Value = Date
    If Application.CountBlank(Range("B:P")) = 0 Then Cells(c.Row, 1).ClearContents
    Next
    Application.EnableEvents = -1
End With
End Sub
Эффекта 0
 
 
 
#7
27.07.2017 14:12:51
Цитата
neqkeet написал: добрее нужно быть
... и не заставлять других создавать файл, тем более что помощь нужна Вам
 
 
 
#8
27.07.2017 15:11:21
vikttur, я никого не заставляю их создавать.  У меня попросту нет возможности заливать файлы с рабочего ПК... Чтобы проверить данный код даже не нужны тестовые данные, достаточно пустого файла с указанным выше макросом. Как доберусь до дома, создам новую книгу, скопирую макрос и выложу раз все так сложно  :)
Изменено: neqkeet - 27.07.2017 15:11:29
 
 
 
#9
27.07.2017 17:07:28
neqkeet, если Вам
Цитата
neqkeet написал:
достаточно пустого файла с указанным выше макросом
, почему Вы пишете на форум? Делайте! Мне вот недостаточно и Правила не просто ради каприза говорят:
Цитата
2.3. Приложите файл(ы) с примером (общим весом не более 100 Кб) в реальной структуре и форматах данных ...
Цитата
neqkeet написал:
попросту нет возможности заливать файлы с рабочего ПК
- со вчерашнего дня у Вас была гора таких возможностей, но Вы предпочли ничего не делать. Сидеть и ждать. Но.. см. ответ №5.
Я сам - дурнее всякого примера! ...
 
 
 
#10
27.07.2017 22:29:00
Цитата
kuklp написал:
со вчерашнего дня у Вас была гора таких возможностей,
Откуда Вы знаете, Вы что следите за мной?  :D

Файл выложил. Есть небольшой нюанс - дома у меня mac os и макрос в excel 2016 почему то не работает, но у Вас, по идее, работать должен. Если не будет, походу придется ставить винду второй осью  :D  
Изменено: neqkeet - 27.07.2017 22:45:37
 
 
 
#11
27.07.2017 23:03:25
Цитата
neqkeet написал:
дома у меня mac os
Потому и не работает: говорят, что там нет событийных процедур )
 
 
 
#12
27.07.2017 23:07:57
Цитата
Юрий М написал:
там нет событийных процедур
есть. Только они с винды не переносятся - нужно по-новой макрос писать.
 
 
 
#13
27.07.2017 23:27:44
Во как! А говорили, что нет )
Буду знать )
 
 
 
#14
14.08.2017 09:26:40
Добрый день!

Так и не решил проблему. Сейчас есть следующий код:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c
 With Target
 If Intersect(.Cells, Range("B:P")) Is Nothing Then Exit Sub
    Application.EnableEvents = 0
    For Each c In .Cells
      If Not IsDate(Cells(c.Row, 1)) Then Cells(c.Row, 1).Value = Date
      If Application.CountBlank(Cells.Range("B:P")) = 0 Then Cells(c.Row, 1).ClearContents
    If IsEmpty(c.Cells) Then Cells(c.Row, 1).ClearContents
    Next
    Application.EnableEvents = -1
End With
End Sub
Данный код производит очистку столбца A при любых манипуляциях (удаление, редактирование) с ячейкой диапазона "B:P". Необходима очистка столбца А только при отсутствии данных во всем диапазоне "B:P". Прошу помочь.
 
 
 
#15
15.08.2017 11:19:39
Покажите файл-пример
Согласие есть продукт при полном непротивлении сторон
 
 
 
#16
15.08.2017 23:47:45
Sanja, показываю  :)  
 
 
 
#17
16.08.2017 01:05:59
Код
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim a()
  Dim i As Long, r As Long, c As Long
  Dim Rng As Range
  Set Rng = Intersect(Target, Me.UsedRange.EntireRow.Range("A:P"))
  If Rng Is Nothing Then Exit Sub
  Set Rng = Intersect(Rng.EntireRow, Me.Range("A:P"))
  a() = Rng.Value
  For r = 1 To UBound(a)
    i = 0
    For c = 2 To UBound(a, 2)
      If Len(Trim(a(r, c))) > 0 Then
        i = 1
        If Len(Trim(a(r, 1))) = 0 Then a(r, 1) = Date
        Exit For
      End If
    Next
    If i = 0 Then a(r, 1) = Empty
  Next
exit_:
  Application.EnableEvents = False
  Rng.Columns(1).Value = a()
  Application.EnableEvents = True
End Sub
Изменено: ZVI - 16.08.2017 01:22:04
 
 
 
Страницы: 1
Наверх