Добавление строк в большом наборе данных первенствуйте

Question

У меня есть рабочий лист первенствовать, что я работаю в, она имеет около 28k строк,

Я импортировать данные из вторичного Excel лист, однако, форматирование отличается.

Данные представляют собой, например, ежедневные данные за период с 1951 по 2011 год, и мне нужно вставить строку в конце каждого года для расчетов, которые я делаю.

Я искал код VBA для автоматизации этого и пробовал формат художника из другой книги в активную, но это, похоже, не импортирует пробелы.

В принципе, я ищу любой способ автоматизировать этот процесс, так как в настоящее время я делаю «Ctrl F: 1952», вставляю строку, затем полоскаю и повторяю на каждый год. Я должен сделать это через 10 разных листов, поэтому любая помощь с благодарностью принимается.

Answer 1

Вот пример кода, который должен получить вас довольно далеко. Хотя определенно было бы быстрее использовать функцию find в вашем коде, я считаю, что с ней немного больнее работать, поэтому я проделал легкий путь здесь. Обратите внимание на допущения, перечисленные в коде. Вы можете расширить его, чтобы работать с несколькими листами с циклом.

Sub InsertRowBetweenYears() 

'ASSUMPTIONS: 
'1) Years are listed in a single column 
'2) Data is sorted by year from oldest to newest (we are going to loop backwards from newest to oldest) 
'3) Sample data contained 3 columns: ColA = Random Word, ColB = Random Number, ColC = Year 
'4) Sample data included years from 1950 to 1969. 
'5) I tested having a variable number of rows per year, as well as having some years missing from the data 

Dim rYears, test_year As Range 
Dim cur_year As Long 

'Make efficient 
Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 

'Set the first & last year expected in your data 
Const START_YEAR = 1950 
Const END_YEAR = 1969 

'Set the range where you should look for the years (in a single column) 
Set rYears = Range("C1:C40") 

cur_year = END_YEAR 

'Loop backwards through the years column and insert a row whenever the year changes 
For r = (rYears.Rows.Count + rYears.Row - 1) To rYears.Row Step -1 
    Set test_year = rYears.Offset(r - 1, 0).Resize(1) 
    If test_year <> cur_year Then 
     Rows(test_year.Row + 1).Insert shift:=xlDown, copyOrigin:=xlxlFormatFromLeftOrAbove 

     'Update "cur_year" to the next year 
     cur_year = test_year 
    End If 
Next 

'Reset settings 
Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic 

End Sub 

Pic выборки данных:

Answer 2

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

Вставляет новый ряд в конце каждого года.

не копирует данные

Это делает счет на пропуске лет.

Sub InsertRowAfterYear() 

Dim lastRow As Long 
Dim tempYear As Long 
Dim ws As Worksheet 
Dim lRow As Long 

    Set ws = ActiveSheet 
    lRow = 2 
    lastRow = ws.Range("A" & Rows.count).End(xlUp).row 

    Do While lRow <= lastRow 
      tempYear = ws.Cells(lRow, "A").Value  'Search Year in Column A 

      If ws.Cells(lRow + 1, "A") <> tempYear Then 
       tempYear = ws.Cells(lRow + 1, 1) 
       ws.Cells(lRow + 1, 1).EntireRow.Insert 
       lRow = lRow + 1 
       lastRow = ws.Range("A" & Rows.count).End(xlUp).row 
      End If 
     lRow = lRow + 1 
    Loop 
End Sub