Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 21.05.2018, 18:38   #1
Afterlight
Пользователь
 
Регистрация: 05.05.2018
Сообщений: 10
Восклицание Дата обновления ячеек

Здравствуйте,

Очень нужно иметь столбец например "А" где будет менятся дата если кокретные несколько столбов имеют в строке обновления. Нашел такой код...

Но тут данные обновляются напротив ячеек с отступом в "xOffsetColumn = 2" в две ячейки. А мне надо чтобы А1, поменяла дату если, E1, F1, Z1 имеют обновления. Как видно даже ActiveSheet.Range("E:Z") тут не помошник ибо не по порядку.. Помогите!

Код:
Private Sub Worksheet_Change(ByVal Target As Range)
'Update 20140722
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("M:Q"), Target)
xOffsetColumn = 2
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetColumn).Value = Now
            Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy"
        Else
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If
End Sub
_____
Код программы нужно выделять (форматировать) тегами [CODE] (читать FAQ)
Модератор

Последний раз редактировалось Serge_Bliznykov; 21.05.2018 в 21:14.
Afterlight вне форума Ответить с цитированием
Старый 23.05.2018, 05:01   #2
Afterlight
Пользователь
 
Регистрация: 05.05.2018
Сообщений: 10
По умолчанию

Для уточнения если я запутанно выразился. Например буква в строке 1, в столбе "Информация 1", и/или "Информация 2" и/или "Информация 3" поменяется, то на той же строке обновится дата. Так как между столбами Информация есть например "Комментарий", то по этому и надо не все разом, а конкретные столбы рассматривать.

Код:
Дата	   Строка	 	Информация 1	Комментарий 1	Информация 2	Комментарий 1	Способ	Модель	Информация 3
22.05.2018	1	 	А	 	                  Б	 	 	 	          В
22.05.2019	2	 	Г	 	                  Д	 	 	 	          Е
Afterlight вне форума Ответить с цитированием
Старый 30.05.2018, 23:14   #3
Afterlight
Пользователь
 
Регистрация: 05.05.2018
Сообщений: 10
По умолчанию

Код:
Private Sub Worksheet_Change(ByVal Target As Range)
    'Update 20140722
    Dim WorkRng As Range
    Dim Rng    As Range
    Dim xOffsetColumn As Integer
    Set WorkRng = Intersect(Application.ActiveSheet.Range("G:G,H:H,I:I,J:J,K:K"), Target)
    If Not WorkRng Is Nothing Then
        Application.EnableEvents = False
        For Each Rng In WorkRng
            If Rng.Column = 7 Then xOffsetColumn = 8
            If Rng.Column = 8 Then xOffsetColumn = 7
            If Rng.Column = 9 Then xOffsetColumn = 6
            If Not VBA.IsEmpty(Rng.Value) Then
                Rng.Offset(0, xOffsetColumn).Value = Now
                Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy"
            Else
                Rng.Offset(0, xOffsetColumn).ClearContents
            End If
        Next
        Application.EnableEvents = True
    End If
End Sub
Блин такто все хорошо, но когда я загружаю информацию, лист не активен, и ничего не выходит, пока его не отркыть и ручками не вписивать инфу.

Подскажите как обойти понятие ActiveSheet. Я на основном листе загрузки DATA LOAD а листы с информацией называются хаотично (У всех 4 буквы в начале совподают ListXXX)
Afterlight вне форума Ответить с цитированием
Старый 31.05.2018, 00:02   #4
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,856
По умолчанию

Цитата:
но когда я загружаю информацию, лист не активен
а как вы загружаете туда информацию?

Цитата:
Подскажите как обойти понятие ActiveSheet
замените
Код:
Application.ActiveSheet.Range
на
Код:
Target.Parent.Range
(Target.Parent вернёт ссылку на лист, к которому относится диапазон ячеек Target)
EducatedFool вне форума Ответить с цитированием
Старый 31.05.2018, 00:18   #5
Afterlight
Пользователь
 
Регистрация: 05.05.2018
Сообщений: 10
По умолчанию

Код:
Sub MacroRun()
    Dim listsName() As String
    Dim i As Long, j As Integer, jCol As Byte
    Dim jList As Byte
    Dim oneList As Worksheet
    Dim onListRowsCount As Integer
    Dim lCount As Integer
    Dim dataRowsCount As Integer
    Dim warnString As String, flag As Boolean
    lCount = -1
    warnString = ""
    For i = 1 To ThisWorkbook.Sheets.Count
        With ThisWorkbook.Sheets(i)
            If Left(LCase(.Name), 4) = "list" Then
              lCount = lCount + 1
              ReDim Preserve listsName(lCount)
              listsName(lCount) = .Name
            End If
        End With
    Next i
    
    With ThisWorkbook.Sheets("DATA LOAD")
        dataRowsCount = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 5 To dataRowsCount
            flag = False
            For jList = LBound(listsName) To UBound(listsName)
                Set oneList = ThisWorkbook.Sheets(listsName(jList))
                onListRowsCount = oneList.Cells(oneList.Rows.Count, 1).End(xlUp).Row
                For j = 5 To onListRowsCount
                    If LCase(oneList.Cells(j, "A")) = LCase(.Cells(i, "A")) Then
                        flag = True
                        .Cells(i, "a").Interior.ColorIndex = 4
                        For jCol = 2 To 11
                            If .Cells(i, jCol) <> "" Then
                                oneList.Cells(j, jCol) = .Cells(i, jCol)
                            End If
                        Next jCol
                    End If
                Next j
            Next jList
            If Not flag Then warnString = warnString & "[" & .Cells(i, "A") & "] "
        Next i
    End With
    Set oneList = Nothing
    MsgBox "Successfully ended loading your data, master!"
End Sub
Этот код ис предыдущей темы.
Afterlight вне форума Ответить с цитированием
Старый 31.05.2018, 00:37   #6
Afterlight
Пользователь
 
Регистрация: 05.05.2018
Сообщений: 10
По умолчанию

Код:
Private Sub Worksheet_Change(ByVal Target As Range)
    'Update 20140722
    Dim WorkRng As Range
    Dim Rng    As Range
    Dim xOffsetColumn As Integer
    Set WorkRng = Intersect(Target.Parent.Range("L:N"), Target)
    If Not WorkRng Is Nothing Then
        Application.EnableEvents = False
        For Each Rng In WorkRng
            If Rng.Column = 12 Then xOffsetColumn = -10
            If Rng.Column = 13 Then xOffsetColumn = -10
            If Rng.Column = 14 Then xOffsetColumn = -10
            If Not VBA.IsEmpty(Rng.Value) Then
                Rng.Offset(0, xOffsetColumn).Value = Now
                Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy"
            Else
                Rng.Offset(0, xOffsetColumn).ClearContents
            End If
        Next
        Application.EnableEvents = True
    End If
End Sub
СПАСИБО!
Afterlight вне форума Ответить с цитированием
Старый 31.05.2018, 17:38   #7
Afterlight
Пользователь
 
Регистрация: 05.05.2018
Сообщений: 10
По умолчанию

Ан нет, не так работает как надо. Даже если подгружается информация которая совпадает с существующей, идет датирование. Пытался поправить так, но не работает.. Что я делаю не так? И еще странность, если значение обновляемое 0,5 (что соответствует 50% то датирование не происходит, но вот если 1 (100%) то дата обновляется (даже если и так было 100%). Но если вбить руками на 50%, теже 50% и нажать ввод, то дата выставляется..

Также если направить этот скрипт пасти ячейку со средним значением, то даже если ячейка меняет результат, то скрипт не понимает что она обновилась. Похоже он видит только что =сред.знач(а1:а2), и все, хоть головой об стол.

Код:
Private Sub Worksheet_Change(ByVal Target As Range)
    'Update 20140722
    Dim WorkRng As Range
    Dim Rng    As Range
    Dim xOffsetColumn As Integer
    Set WorkRng = Intersect(Target.Parent.Range("G:K"), Target)
    If Not WorkRng Is Nothing Then
        Application.EnableEvents = False
        For Each Rng In WorkRng
            If Rng.Column = 7 Then xOffsetColumn = 5
            If Rng.Column = 8 Then xOffsetColumn = 4
            If Rng.Column = 9 Then xOffsetColumn = 3
            If Rng.Column = 10 Then xOffsetColumn = 2
            If Rng.Column = 11 Then xOffsetColumn = 1
            'If Not VBA.IsEmpty(Rng.Value) Then
            If WorkRng.Value <> PrevVal Then
                Rng.Offset(0, xOffsetColumn).Value = Now
                Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy"
            Else
                Rng.Offset(0, xOffsetColumn).ClearContents
            End If
        Next
        Application.EnableEvents = True
    End If
End Sub

Последний раз редактировалось Afterlight; 31.05.2018 в 17:50.
Afterlight вне форума Ответить с цитированием
Старый 01.06.2018, 11:41   #8
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,856
По умолчанию

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

Событие Worksheet_Change срабатывает при любом изменении ячеек на листе
(даже если данные не поменялись, но в ячейку была выполнена вставка чего-то)
EducatedFool вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Перевод числовых ячеек в дата формат Beginner_Access Microsoft Office Excel 2 28.03.2017 17:33
После обновления вордпресс, обновления плагина woocommerce, после оформления заказов не показывает количество купленных товаров Алекс Мельников WordPress и другие CMS 4 24.07.2016 02:28
Создание истории обновления ячеек до полного заполнения листа qwerty456 Microsoft Office Excel 4 24.10.2015 10:46
Экспорт из DBGrid в Excel и формат ячеек Дата demiancz БД в Delphi 0 21.12.2013 14:46
Объединение ячеек - дата отображается неправильно. Ppaa Microsoft Office Excel 9 16.01.2013 19:03