Создание нескольких историй данных с помощью Excel VBA с использованием LastRow, Time Stamp и Workbook.sheetchange

Question

Я запрограммировал ручной макрос в Excel VBA, который отображает 2 или в будущем несколько таблиц, чтобы показать историю определенных данных на листе, называемом «оценка». Данные, на которые я ссылаюсь, находятся в таблице «контрольный список» (см. Ниже). Проблема в том, что данные в «контрольном списке» меняются каждый день или чаще. Каждый раз, когда лист меняет макрос, он должен вставить новую строку с новой датой в LastRow таблицы в разделе «Оценка». Я хотел бы отобразить историю данных в «оценке». Таким образом, значения в строке последнего изменения должны оставаться стабильными. Так, например, строка 1 в «оценке»: 2020-01-17 значение равно 1 (это должно остаться 1, потому что я хочу видеть прогресс) Теперь лист меняется, и строка 2 вставляется: строка 2: 2020-01-18 значение теперь равно 2 (скопировано из контрольного списка), и я хочу, чтобы значение в строке 1 оставалось равным 1 (потому что это было 1 до последнего изменения). Эта часть прекрасно работает с моим первым кодом: (см. Ниже), но если я хочу записать данные второй таблицы (код 2), то ничего не происходит ... Нужно ли просто внести корректировку в мой первый код или как Готово? Прямо сейчас это выглядит так:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range)
    If Sh.Name = "checklist" Then
          'Monitoring from A3:E100, if different change this
          If Not Intersect(target, Range("A3:E3")) Is Nothing Then
             'if any monitoring here, please you add here
             Test target 'Here procedure to insert
          End If
    End If
End Sub


Private Sub Test(target As Range)
    Dim LastRow As Long

    LastRow = Range("evaluation!A" & Sheets("evaluation").Rows.Count).End(xlUp).Row

    If Range("evaluation!A1").Value <> "" Then
       LastRow = LastRow + 1
    End If
    'every change A3:E in checklist will insert row to this evaluation
    'but if different please you decide here
    Range("evaluation!A" & LastRow).Value = Format(Now, "dd.mm.yyyy hh:mm") 'you can change this
    Range("evaluation!B" & LastRow & ":F" & LastRow).Value = Range("checklist!A" & target.Row & ":E" & target.Row).Value
End Sub

первые коды предназначены для первой таблицы, а приведенный ниже - для второй таблицы:

Private Sub Workbook_SheetChange2(ByVal Sh As Object, ByVal target As Range)
    If Sh.Name = "checklist" Then
          'Monitoring from A3:E100, if different change this
          If Not Intersect(target, Range("G3:K3")) Is Nothing Then
             'if any monitoring here, please you add here
             Test target 'Here procedure to insert
          End If
    End If
End Sub


Private Sub Test2(target As Range)
    Dim LastRow As Long

    LastRow = Range("evaluation!H" & Sheets("evaluation").Rows.Count).End(xlUp).Row

    If Range("evaluation!H1").Value <> "" Then
       LastRow = LastRow + 1
    End If
    'every change A3:E in checklist will insert row to this evaluation
    'but if different please you decide here
    Range("evaluation!H" & LastRow).Value = Format(Now, "dd.mm.yyyy hh:mm") 'you can change this
    Range("evaluation!I" & LastRow & ":M" & LastRow).Value = Range("checklist!G" & target.Row & ":K" & target.Row).Value
End Sub

У вас есть идеи, как подключить эти коды? Извините, я на самом деле не эксперт VBA. Я сделал Google лист, чтобы показать, что я на самом деле имею в виду, но мне нужно это в Excel VBA, Google лист просто для того, чтобы визуализировать, что я имею в виду: https://docs.google.com/spreadsheets/d/1OU_95Lhf6p0ju2TLlz8xmTegHpzTYu4DW0_X57mObBc/edit#gid = 0

Answer 1

Я думаю, вы просто забыли добавить «2». Что касается вашего второго кода, он по-прежнему вызывает Test вместо вызова Test2.

Я буду рад покопаться, если это не ошибка. Но так как первый работает для вас, второй должен работать тоже. Будем надеяться.

Редактировать после комментария OP:

Я имел в виду, что вы дважды вызывали подпункт "Test", а на самом деле никогда не вызывали Test2 (также я не видел 2 в вашей второй смене листа).

Просто объедините два SheetChanges и правильно вызовите сабы TestX.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range)
    If Sh.Name = "checklist" Then

          'Monitoring from A3:E100, if different change this
          If Not Intersect(target, Range("A3:E3")) Is Nothing Then
             'if any monitoring here, please you add here
             Test target 'Here procedure to insert
          End If

          If Not Intersect(target, Range("G3:K3")) Is Nothing Then
             'if any monitoring here, please you add here
             Test2 target 'Here procedure to insert
          End If
    End If

End Sub 

Answer 2

Это мой подход

1. Преобразование диапазонов в таблицы Excel
2. Поместите код за листом контрольного списка

Лист контрольного списка Название таблицы на этом листе: TableCheckList

Оценочный лист Имена таблиц на этом листе TableHistory01 и TableHistory02

Код:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim checkListTable As ListObject
    Dim checkListRow As ListRow

    Set checkListTable = Range("TableCheckList").ListObject

    If Intersect(Target, checkListTable.DataBodyRange) Is Nothing Then Exit Sub

    Set checkListRow = checkListTable.ListRows(Target.Row - checkListTable.HeaderRowRange.Row)

    AddHistory Target, "TableHistory01", checkListRow

    AddHistory Target, "TableHistory02", checkListRow

End Sub

Private Sub AddHistory(ByVal Target As Range, ByVal HistoryTableName As String, ByVal checkListRow As ListRow)

    Dim historyTable As ListObject
    Dim newRow As ListRow

    Set historyTable = ThisWorkbook.Worksheets("Evaluation").ListObjects(HistoryTableName)

    ' Add a row to that table
    Set newRow = historyTable.ListRows.Add(alwaysInsert:=True)

    ' Fill the row with source values
    With newRow
        .Range.Cells(1).Value = Format(Now, "dd.mm.yyyy hh:mm")
        .Range.Cells(2).Value = checkListRow.Range.Cells(1)
        .Range.Cells(3).Value = checkListRow.Range.Cells(2)
        .Range.Cells(4).Value = checkListRow.Range.Cells(3)
        .Range.Cells(5).Value = checkListRow.Range.Cells(4)
        .Range.Cells(6).Value = checkListRow.Range.Cells(5)
    End With

End Sub

Некоторые замечания:

1. Ваш код добавляет строки при каждом изменении ячейки. Это цель? Может быть, когда строка в контрольном списке изменена / добавлена?
2. Вы упомянули о записи дней, но ваш код добавляет время тоже

Вот ссылка на образец

Некоторые ссылки примерно на списки объектов (таблицы Excel)

Дайте мне знать, если это работает