Страницы: 1
RSS
Перенос на другой лист измененной ячейки при сохранении книги
 
Добрый день, нужна помощь со следующей задачей:

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

Подскажите пожалуйста, как изменить код, что бы при сохранении книги на другой лист переносилось только те значения, которые были изменены?
 
Добрый вечер, можно создать копию таблицы (например на листе 3), по которой будет вестись сравнение значений с данными первого листа, и дописать условие проверки идентичности данных - если значения не равны, то тогда внести запись в таблицу отслеживания... после заполнения списка изменений обновлять данные таблицы сравнения (лист 3).
 
А подскажите пожалуйста - как дописать это условие проверки идентичности данных? если в код макроса, то какой должен быть код? Или формулой?
 
Цитата
markskavr написал:
как дописать это условие проверки идентичности данных?
Строку
Код
Worksheets("Values2").Cells(LastRow + i, 1) = Worksheets("Values1").Cells(3, 1).Value
заменить на
Код
if Worksheets("Values1").Cells(3, 1) <> Worksheets("Values3").Cells(3, 1) Then Worksheets("Values2").Cells(LastRow + i, 1) = Worksheets("Values1").Cells(3, 1).Value

Лист "Values3", в данном случае, должен содержать проверочную таблицу. По такому же принципу, изменить все строки в циклах.
Изменено: Настя_Nastya - 10.08.2019 21:20:58
 
Спасибо большое за помощь.
 
Добрый день, снова прошу о помощи. Переписал код под свои нужды, но при его прописывании для каждой ячейки Excel в итоге выдаёт ошибку, что процедура слишком большая. Подскажите пожалуйста, возможно ли изменить код сохранив суть решения задачи, но сократив его, что бы Excel не выдавал ошибку. Последняя версия кода в прикрепленном примере.
 
Это что?
Код
For i = 0 To 0


Цитата
markskavr написал: процедура слишком большая
30 строк - слишком много?
 
vikttur,
это очевидно, значит выполнить цикл 1 раз  (это цикл на перспективу)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Игорь, если несколько изменить твою подпись:)
Цитата
Авторы тем иногда создают себе проблемы, о существовании которых не подозревают, методами, которых не понимают
 
Excel выдает ошибку, что процедура слишком большая. По поводу:
Код
For i = 0 To 0
это из предыдущей версии кода, потому может сейчас эта строка правда не нужна - я плохо разбираюсь в макросах, писал предыдущий код по примерам из интернета.

Мой код из последнего примера нужно применить для очень большого количества ячеек, и когда дошло примерно до 20-й Excel стал ругаться на большой размер процедуры. Был бы рад совету, как сократить код.
Изменено: markskavr - 12.08.2019 00:20:45
 
Уговорили )
Не сократить код, а  изменить подход полностью. Работа с объектами листа медленная - уходим в массивы. Обращаться к каждому значению отдельной строкой трудозатратно и уйма лишней писанины - создаем циклы.
Код
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim aData1(), aData2(), aRes()
    Dim sSeason As String, sGroup As String
    Dim i As Long, k As Long, j As Long

    With Worksheets("Values1")
        i = .UsedRange.Rows.Count: If i < 2 Then Exit Sub
        aData1 = .UsedRange.Value                ' данные Values1 в массив
    End With

    aData2 = Worksheets("Values2").Range("A1").Resize(UBound(aData1), UBound(aData1, 2)).Value ' данные Values3 в массив
    ReDim aRes(1 To UBound(aData1) * UBound(aData1, 2), 1 To 8) ' размерность массива выгрузки (с запасом)

    For i = 3 To UBound(aData1)                                 ' цикл по строкам
        If aData1(i, 1) <> Empty Then sSeason = aData1(i, 1)    ' если есть значение, сезон в переменную

        For j = 4 To UBound(aData1, 2)                          ' цикл по столбцам
            If aData1(1, j) <> Empty Then sGroup = aData1(1, j) ' если есть значение, группа в переменную

            If aData1(i, j) <> aData2(i, j) Then ' если значения разные
                k = k + 1                        ' новая запись в массиве
                aRes(k, 1) = sSeason             ' сезон
                aRes(k, 2) = aData1(i, 2)        ' агл
                aRes(k, 3) = aData1(i, 3)        ' рус
                aRes(k, 4) = aData1(2, j)        ' ФИО
                aRes(k, 5) = sGroup              ' группа
                aRes(k, 6) = aData2(i, j)        ' значение из Values2
                aRes(k, 7) = aData1(i, j)        ' значение из Values2
                aRes(k, 8) = Format(Now, "dd/mm/yyyy hh:mm:ss") & " " & Application.UserName
                aData2(i, j) = aData1(i, j)      ' изменение в массиве Values2
            End If
        Next j
    Next i

    With Worksheets("result")
        i = .UsedRange.Rows.Count
        
        If i > 1 Then
            If MsgBox("Удалить предыдущие данные и внести изменения?", 64 + vbYesNo, "ОЧИСТКА") = vbNo Then Exit Sub
            .Rows("2:" & i).Delete ' чистим, если нужно, лист
        End If
        
        If k > 0 Then                           ' если есть изменения
            Application.DisplayAlerts = False
            
            .Range("A2").Resize(k, UBound(aRes, 2)).Value = aRes ' выгружаем изменения на Values2
            Worksheets("Values2").Range("A1").Resize(UBound(aData2), UBound(aData2, 2)).Value = aData2 ' меняем данные
            
            Application.DisplayAlerts = True
            MsgBox "OK", 64, ""
        End If
    End With
End Sub
 
vikttur, спасибо вам огромное за труд и отклик
 
vikttur, снова прошу помочь,

хотелось бы что бы лист "result" вообще не чистился - все изменения после сохранения один за другим сохранялись,

скажите пожалуйста, как изменить ваш код, что бы после более чем одного изменений и сохранений макрос не выводил сообщение с предложением "Удалить предыдущие данные и внести изменения?", а просто сохранял эти изменения на лист "result" строчкой ниже всех предыдущих данных?  
Изменено: markskavr - 17.08.2019 21:20:25
 
Цитата
markskavr написал: что бы после более чем одного изменений и сохранений макрос не выводил сообщение
Как макрос поймет, что данные в таблице нужно/не нужно удалять? Допустим, записали где-то флаг... А если нужно будет почистить таблицу?
Нужно или отказаться от автоочистки, или, как в коде ниже. Замените последний фрагмент макроса:
Код
    With Worksheets("result")
        i = .UsedRange.Rows.Count
        
        If i > 1 Then
            If MsgBox("Удалить предыдущие данные?", 64 + vbYesNo, "ОЧИСТКА") = vbYes Then
                .Rows("2:" & i).Delete ' чистим, если нужно, лист
            End If
        End If
        
        If k > 0 Then                           ' если есть изменения
            Application.DisplayAlerts = False
            
            i = .UsedRange.Rows.Count + 1
            .Cells(i, 1).Resize(k, UBound(aRes, 2)).Value = aRes ' выгружаем изменения на Values2
            Worksheets("Values2").Range("A1").Resize(UBound(aData2), UBound(aData2, 2)).Value = aData2 ' меняем данные
            
            Application.DisplayAlerts = True
            MsgBox "OK", 64, ""
        End If
    End With
 
vikttur, спасибо большое.
Страницы: 1
Наверх