Найти и скопировать последнюю строку на другой лист + неограниченное резервное копирование строки при активации макроса - PullRequest
Новая
       0

Найти и скопировать последнюю строку на другой лист + неограниченное резервное копирование строки при активации макроса

0 голосов
/ 29 января 2020

Ситуация:

Я изменил рабочую книгу, которая содержит секундомер. Этот инструмент предназначен для контроля времени простоя линий на заводе. Теперь есть (и я не планирую создавать больше рабочих листов): - Информация (для объяснения, как его использовать); - Ссылка (для размещения ссылок, которые могут / будут редактироваться пользователем); - StopWatch (который содержит часы, кнопки пуска / паузы / остановки + записи и таблицу для его регистрации); - ghist («История призраков», которая будет действовать как резервная копия для каждого раза, когда-либо записанного в этой электронной таблице; - Cal c (Это «импортированная» таблица из листа StopWatch, поэтому некоторые вычисления можно выполнять без прикручивания). лист секундомера).

Как ведет себя рабочая книга

  • Информация: не имеет значения, она чисто информативна;
  • Ссылка: это с указанием времени для часов, столбцы с параметрами для списков проверки данных, в ячейке A1 защищен, чтобы теперь уничтожить ссылку для часов;
  • Секундомер: вы выбираете некоторые параметры в рамках доступной проверки данных перечисляет и записывает (просто значение скорости) в столбец C, Линия, машина, продукт и т. д. c. Затем вы запускаете часы с помощью кнопки, можете приостановить их, с другой, а затем остановить их, чтобы зарегистрировать Прошедшее время. Область регистрации начинается в F3 и заканчивается в столбце S. После окончания измерения данных вы можете импортировать их на лист «Cal c» (я просто копирую значения) и затем, если вы хотите использовать его снова, вы можете очистить таблицу на листе секундомера, чтобы зарегистрировать новые данные. В «фоновом режиме» рабочей книги я, после каждого нажатия кнопки STOP, хочу, чтобы она сделала копию этой строки (последнюю в таблице на рабочем столе StopWatch, последнее измерение) в качестве резервной копии безопасности.

Мои проблемы:

Это обычное явление, но после нескольких дней попыток и ошибок я не мог понять это, это просто, но я не могу преодолеть это. Снова добавив в список:

  • Мне удалось «Франкштайн» код, я могу скопировать последнюю строку и вставить его в следующую пустую строку в листе резервных копий, но, после того, как я ОЧИСТИТЬ основной Таблица листа StopWatch, когда я начинаю снова записывать время, перезаписывает существующие строки, начиная со строки 2.
  • Когда скопированные значения вставляются в столбец F, я хочу их в столбце A.
  • Бывают случаи, когда я запускаю макрос, в листе резервных копий пишу код, копирую последнюю строку основной таблицы и вставляю в резервную копию после остановки часов, если я снова запускаю, я не копирую последний, но предыдущий, 1 и 2, затем я запускаю его снова, он копирует 1, 2 и 3, и продолжаю в том же духе.
  • Если я измерю некоторые точки, то импортирую в cal c Очистите таблицу и затем импортируйте снова, этот новый процесс импорта перезапишет существующие точки.
  • Может экспортировать таблицу cal c в файл csv, f

Мои предположения

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

Я ценю ЛЮБУЮ помощь в этом. Заранее большое спасибо.

Код 


Option Explicit

'Source: https://trumpexcel.com/stopwatch-in-excel/

'-----------------------------------------------------

'Definition of the variable of the time running in the clock
Dim NextTick As Date
Dim t As Date
Dim PreviousTimerValue As Date


Sub Start()

'-----------------------------------------------------

'Unlock the reference cell A1, on Ref Sheet, to be used in the counting of time
Ref.Unprotect Password:="timeref"

'Check the reference time and "free it to run" so the time pass
PreviousTimerValue = Ref.Range("A1").Value
t = Time
Call ExcelStopWatch

'-----------------------------------------------------

End Sub

Private Sub ExcelStopWatch()

'-----------------------------------------------------

'Check the reference time (Cell A1 on Ref), changes the color of the clock acording to the parameters in the Ref sheet
Ref.Range("A1").Value = Format(Time - t + PreviousTimerValue, "hh:mm:ss")
NextTick = Now + TimeValue("00:00:01")

'Green color
If Ref.Range("A1").Value > Ref.Range("B3") And Ref.Range("A1").Value <= Ref.Range("B4") Then
    With StopWatch.Shapes("TimeBox")
        .Fill.ForeColor.RGB = RGB(0, 255, 0)
    End With

'Yellow color
Else
    If Ref.Range("A1").Value > Ref.Range("B4") And Ref.Range("A1").Value <= Ref.Range("B5") Then
    With StopWatch.Shapes("TimeBox")
        .Fill.ForeColor.RGB = RGB(255, 255, 0)
    End With

'Red color
Else
    If Ref.Range("A1").Value > Ref.Range("B5") Then
    With StopWatch.Shapes("TimeBox")
        .Fill.ForeColor.RGB = RGB(255, 0, 0)
    End With
End If
End If
End If

Application.OnTime NextTick, "ExcelStopWatch"

'-----------------------------------------------------


End Sub

Sub Pause()

'Pause command in the clock
On Error Resume Next
Application.OnTime earliesttime:=NextTick, procedure:="ExcelStopWatch", schedule:=False

End Sub

Sub StopReset()

'-----------------------------------------------------

'Stop command that also will copy the parameters defined on the StopWatch worksheet to the main table
On Error Resume Next

'Reset the background color or the clock to white
With StopWatch.Shapes("TimeBox")
        .Fill.ForeColor.RGB = RGB(255, 255, 255)
    End With

'Copy commands, to write down every variable:
If StopWatch.Range("F3") = "" And Ref.Range("A1").Value > 0 Then
    StopWatch.Range("F3").Value = 1                                             'To write the order numbers
    StopWatch.Range("F3").Offset(0, 1).Value = Ref.Range("A1").Value            'To write the duration
    StopWatch.Range("F3").Offset(0, 2).Value = Date + Time                      'To write the Date + Time
    StopWatch.Range("F3").Offset(0, 3).Value = StopWatch.Range("C15").Value     'To copy the Line Name
    StopWatch.Range("F3").Offset(0, 4).Value = StopWatch.Range("C16").Value     'To copy the Machine
    StopWatch.Range("F3").Offset(0, 5).Value = StopWatch.Range("C17").Value     'To copy the Product
    StopWatch.Range("F3").Offset(0, 6).Value = StopWatch.Range("C18").Value     'To copy the Type of Cover
    StopWatch.Range("F3").Offset(0, 7).Value = StopWatch.Range("C19").Value     'To copy the Bottle Size
    StopWatch.Range("F3").Offset(0, 8).Value = StopWatch.Range("C20").Value     'To copy the Bottle Model
    StopWatch.Range("F3").Offset(0, 9).Value = StopWatch.Range("C21").Value     'To copy the Box Formation
    StopWatch.Range("F3").Offset(0, 10).Value = StopWatch.Range("C22").Value    'To copy the Speed of the line
    StopWatch.Range("F3").Offset(0, 11).Value = StopWatch.Range("C23").Value    'To copy the Shift

Else:

'To identify the last used row and use the one after that
    StopWatch.Range("F2").End(xlDown).Offset(1, 0).Value = StopWatch.Range("F2").End(xlDown).Value + 1  'To write the order numbers
    StopWatch.Range("F2").Offset(0, 1).End(xlDown).Offset(1, 0).Value = Ref.Range("A1").Value           'To write the duration
    StopWatch.Range("F2").Offset(0, 2).End(xlDown).Offset(1, 0).Value = Date + Time                     'To write the Date + Time
    StopWatch.Range("F2").Offset(0, 3).End(xlDown).Offset(1, 0).Value = StopWatch.Range("C15").Value    'To copy the Line Name
    StopWatch.Range("F2").Offset(0, 4).End(xlDown).Offset(1, 0).Value = StopWatch.Range("C16").Value    'To copy the Machine
    StopWatch.Range("F2").Offset(0, 5).End(xlDown).Offset(1, 0).Value = StopWatch.Range("C17").Value    'To copy the Product
    StopWatch.Range("F2").Offset(0, 6).End(xlDown).Offset(1, 0).Value = StopWatch.Range("C18").Value    'To copy the Type of Cover
    StopWatch.Range("F2").Offset(0, 7).End(xlDown).Offset(1, 0).Value = StopWatch.Range("C19").Value    'To copy the Bottle Size
    StopWatch.Range("F2").Offset(0, 8).End(xlDown).Offset(1, 0).Value = StopWatch.Range("C20").Value    'To copy the Bottle Model
    StopWatch.Range("F2").Offset(0, 9).End(xlDown).Offset(1, 0).Value = StopWatch.Range("C21").Value    'To copy the Box Formation
    StopWatch.Range("F2").Offset(0, 10).End(xlDown).Offset(1, 0).Value = StopWatch.Range("C22").Value   'To copy the Speed of the Line
    StopWatch.Range("F2").Offset(0, 11).End(xlDown).Offset(1, 0).Value = StopWatch.Range("C23").Value   'To copy the Shift


End If


'-----------------------------------------------------

'Reset the value of the clock to zero
Application.OnTime earliesttime:=NextTick, procedure:="ExcelStopWatch", schedule:=False
Ref.Range("A1").Value = 0

'-----------------------------------------------------

'Protect the cell of reference for the time, A1 on sheet Ref
Ref.Protect Password:="timeref"


'-----------------------------------------------------


'Backup of use, should copy all the lines that once was "stoped" by the button click, the last line of the main table near the clock

'IDK what this line do, but made the 'flickering' of the screen stop.
Application.ScreenUpdating = False

'Defining the variable to find the last row in the main table and in the ghost history (backup)
Dim lastrowSrc As Long
Dim lastrowDest As Long


'Get last row of data
lastrowSrc = Sheets("StopWatch").Range("F" & Rows.Count).End(xlUp).Row

'Get first blank row (last row of data +1)
lastrowDest = Sheets("gHist").Range("A" & Rows.Count).End(xlUp).Row + 1

'Copy row
Sheets("StopWatch").Range("F3:S" & lastrowSrc).EntireRow.Copy Sheets("ghist").Range("A" & lastrowDest)

'Complement of the code to stop the flickering when copying te line.
Application.CutCopyMode = False
Application.ScreenUpdating = True


'-----------------------------------------------------


End Sub


'-----------------------------------------------------

'To clear the main table of the StopWatch

Sub ResetMT()

'Definying the worksheets I'm working with
Dim ws1 As Worksheet
Dim ws2 As Worksheet


'declare an object variable to hold a reference to cells to clear
Dim LRS_Reset As Long
Dim LRB_Reset As Long

Application.ScreenUpdating = False

'Warning message to confirm exclusion
If MsgBox("These changes cannot be undone. This will erase everything! Are you sure?", vbYesNo) = vbNo Then Exit Sub

'Source of the data
Set ws1 = Sheets("StopWatch")

'Backup Sheet
Set ws2 = Sheets("ghist")

'My tentative to "show" to the stop button the last used row, I think it was 'erasing' the capacity of the code to know the last used row in the backup sheet (ghist)
LRS_Reset = ws1.Range("F" & Rows.Count).End(xlUp).Row + 1

'Comment to myself, learning while making the reset of the main table not erease the headers
'OBS: If you add "+1" after .Row you will keep the headings in case the file is empty. [if it is empty and the code runs without "+1" it will erase the headings]

'Definition of the clearing range, this method keeps the formatting style
Range("F3:S" & LRS_Reset).ClearContents

'Attempt to show the code the last used row in the ghist (backup sheet)
LRB_Reset = ws2.Range("A" & Rows.Count).End(xlUp).Row

'Copied from above to stop the flickering (hope its correct)
Application.CutCopyMode = False
Application.ScreenUpdating = True

'-----------------------------------------------------


End Sub

'-----------------------------------------------------

'To import the captured table for the calculations

Sub ImportMT()

'Warning message to confirm exclusion
If MsgBox("This will import the current data for calculation. Are you sure?", vbYesNo) = vbNo Then Exit Sub

Range("F3", Range("F3").End(xlDown).End(xlToRight)).Copy Worksheets("Calc").Range("A2")

'-----------------------------------------------------

End Sub


'-----------------------------------------------------

'Source: https://stackoverflow.com/questions/10220906/how-to-select-clear-table-contents-without-destroying-the-table
'To clear the content of the calc sheet without losing the headers and style/table

Sub ResetCalcTab()

'Warning message to confirm exclusion
If MsgBox("These changes cannot be undone. This will erase everything on this table! Are you sure?", vbYesNo) = vbNo Then Exit Sub

Application.ScreenUpdating = False
Sheets("Calc").Select
ActiveSheet.ListObjects("Calc").HeaderRowRange.Select

'Remove the filters if one exists.
If ActiveSheet.FilterMode Then
Selection.AutoFilter
End If

'Clear all lines but the first one in the table leaving formulas for the next to go round.
With Worksheets("Calc").ListObjects("Calc")
.Range.AutoFilter
On Error Resume Next
.DataBodyRange.Offset(1).Resize(.DataBodyRange.Rows.Count - 1, .DataBodyRange.Columns.Count).Rows.Delete
.DataBodyRange.Rows(1).SpecialCells(xlCellTypeConstants).ClearContents
ActiveWindow.SmallScroll Down:=-10000

End With
Application.ScreenUpdating = True

'-----------------------------------------------------

End Sub```

1 Ответ

0 голосов
/ 29 января 2020

Что касается первого пункта в списке проблем, вы упомянули, что данные вставляются в столбец F на листе «gHist». Тем не менее, вы ищете последнюю строку из столбца A, которая будет пустой и вернет 2. Вот почему она перезаписывается.

Что касается второго пункта в вашем списке проблем, вы копируете всю строку, чтобы она вставит значения в те же столбцы, что и на листе «StopWatch».

Что касается третьего маркера, вы начинаете с «F3» в диапазоне копий, то есть он будет копировать всю таблицу, а не последний ряд

Вместо этого попробуйте исправить все перечисленные выше проблемы: 

'Copy row
Sheets("StopWatch").Range("F" & lastrowSrc & ":S" & lastrowSrc).Copy Sheets("ghist").Range("A" & lastrowDest)

Кроме того, вы можете удалить (или использовать очень экономно) 

On Error Resume Next

как это будет игнорировать ошибки и продолжать работу. Сообщения об ошибках помогут вам определить, что не так.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Нет похожих вопросов

...