将行添加到大型Excel数据集

时间:2014-12-24 01:49:27

标签: excel vba excel-vba

我有一个我正在使用的Excel工作表,它有大约28,000行,

我从辅助Excel工作表导入数据,但格式不同。

例如,数据是1951年至2011年的每日数据,我需要在每年年底插入一行进行计算。

我已经找到了自动执行此操作的VBA代码,并尝试将其他工作簿中的格式画家添加到活动工具簿中,但这似乎不会导入空格。

基本上,我正在寻找任何方法来自动化这个过程,就像目前一样,我正在做" Ctrl F:1952",插入行,然后冲洗并重复每年。 我必须在10张不同的表格中这样做,所以我们非常感谢您的帮助。

2 个答案:

答案 0 :(得分:1)

这可以满足您的要求,但您可能需要根据自己的需要进行调整。

它在每年年底插入一个新行。

它不会复制数据

它确实可以解释多年。

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

BEFORE AFTER

答案 1 :(得分:0)

这里有一些示例代码可以让你走得很远。虽然在你的代码中使用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

示例数据图片

enter image description here