У меня есть таблица с дублирующимися названиями компаний, поскольку у каждого из них есть ряд данных, основанных на годовых значениях. Я пытался создать код импорта, чтобы добавить строку для каждой компании с добавлением сведений о следующем году. Мой код фильтрует столбец E, в котором указан год от наименьшего к наибольшему числу. Я использую максимальный код, чтобы получить первый экземпляр наибольшего числа. а затем я получаю последний номер строки и последний номер строки плюс 1 значения. Затем я могу скопировать и вставить диапазон в следующую пустую строку. Затем мне нужно очистить диапазон в столбце H и столбцах от N до AD. Мне нужно убедиться, что столбцы J: K имеют формат дд / мм / гггг, чтобы мой код мог менять годы только для дат в столбцах J и K. Мой код, приведенный ниже, работает, но для его запуска может потребоваться от 20 до 30 минут,и может замерзнуть. Мои компьютерные спецификации довольно хороши, поэтому не уверен, почему этот маленький кусочек кода занимает так много времени. Любая помощь будет высоко ценится, так как я часами искал решение.
Sub AddNewYear()
othwb = Application.Workbooks.Count
If othwb > 1 Then MsgBox "Please save and close any other workbooks before running this code", , "Panda": Exit Sub
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim d As Date
Dim da As Date
Dim lrow As Long
Dim copy_range As Range
lrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
Application.ActiveWorkbook.Worksheets("Financial Data").Range("J2", "K200000") = Format(Date, "dd/mm/yyyy")
lrow1 = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row + 1
Dim tabl As ListObject
Set tabl = Sheet1.ListObjects(1)
Sheet1.ListObjects.item(1).ShowTotals = False
Dim orgid As String
Dim yearchoice As Variant
tabl.AutoFilter.ShowAllData
yearchoice = Application.WorksheetFunction.Max(Range("E:E"))
Set copy_range = Sheet1.Range("A2:AZ" & lrow)
tabl.Range.AutoFilter Field:=5, Criteria1:=yearchoice
copy_range.SpecialCells(xlCellTypeVisible).Copy Sheet1.Range("A" & lrow1)
tabl.AutoFilter.ShowAllData
Dim lrow2
lrow2 = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
Sheet1.Range("H" & lrow1 & ":H" & lrow2).ClearContents
Sheet1.Range("N" & lrow1 & ":AD" & lrow2).ClearContents
Dim x
yearchoice = yearchoice + 1
For x = lrow1 To lrow2
Sheet1.Range("E" & x).Value = yearchoice
Sheet1.Range("F" & x).Value = "A"
Sheet1.Range("G" & x).Value = yearchoice & Sheet1.Range("F" & x).Value
Sheet1.Range("H" & x).Value = 0
d = Sheet1.Range("J" & x).Value
Sheet1.Range("J" & x).Value = DateSerial(year(d) + 1, Month(d), Day(d))
da = Sheet1.Range("K" & x).Value
Sheet1.Range("K" & x).Value = DateSerial(year(da) + 1, Month(da), Day(da))
Next x
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub