Excel VBA 在范围末尾插入/删除行

Excel VBA to insert/delete rows at end of range

提问by AdRock

I need to insert or delete some rows depending on what a variable states.

我需要根据变量状态插入或删除一些行。

Sheet1 has a list of data. With sheet2 which is formatted, i want to copy that data so sheet2 is just a template and sheet1 is like a user form.

Sheet1 有一个数据列表。使用格式化的 sheet2，我想复制该数据，因此 sheet2 只是一个模板，而 sheet1 就像一个用户表单。

What my code does up until the for loop is get the number of rows in sheet 1 which only contains data and also the number of rows in sheet2 which contains data.

我的代码在 for 循环之前所做的工作是获取仅包含数据的工作表 1 中的行数以及包含数据的工作表 2 中的行数。

If the user adds some more data to sheet1 then i need to insert some more rows at the end the data in sheet2 and if the user deletes some rows in sheet1 the rows are deleted from sheet2.

如果用户向 sheet1 添加更多数据，那么我需要在 sheet2 中的数据末尾插入更多行，如果用户删除 sheet1 中的某些行，则从 sheet2 中删除行。

I can get the number of rows on each so now how many to insert or delete but that's where i've come unstuck. How would I insert/delete the correct amount of rows. Also i wanted to alternate the rows colours between white and grey.

我可以得到每行的行数，所以现在插入或删除多少行，但这就是我陷入困境的地方。我将如何插入/删除正确数量的行。我也想在白色和灰色之间交替行颜色。

I did think that it might be an idea to delete all the rows on sheet2 then insert the same amount of rows that are in sheet1 using the alternating row colours but then again i did see something about using mod in the conditional formatting.

我确实认为删除 sheet2 上的所有行然后使用交替的行颜色插入 sheet1 中相同数量的行可能是一个想法，但后来我确实看到了一些关于在条件格式中使用 mod 的内容。

Can anyone please help?

有人可以帮忙吗？

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim listRows As Integer, ganttRows As Integer, listRange As Range, ganttRange As Range
    Dim i As Integer


    Set listRange = Columns("B:B")
    Set ganttRange = Worksheets("Sheet2").Columns("B:B")

    listRows = Application.WorksheetFunction.CountA(listRange)
    ganttRows = Application.WorksheetFunction.CountA(ganttRange)

    Worksheets("Sheet2").Range("A1") = ganttRows - listRows

    For i = 1 To ganttRows - listRows
        'LastRowColA = Range("A65536").End(xlUp).Row


    Next i

    If Target.Row Mod 2 = 0 Then
        Target.EntireRow.Interior.ColorIndex = 20
    End If

End Sub

回答by Scott Holtzman

I didn't test this, because I didn't have sample data, but try this out. You may need to change some of the cell referencing to fit your needs.

我没有测试这个，因为我没有样本数据，但试试这个。您可能需要更改某些单元格引用以满足您的需要。

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim listRows As Integer, ganttRows As Integer, listRange As Range, ganttRange As Range
    Dim wks1 As Worksheet, wks2 As Worksheet

    Set wks1 = Worksheets("Sheet2")
    Set wks2 = Worksheets("Sheet1")

    Set listRange = Intersect(wks1.UsedRange, wks1.columns("B:B").EntireColumn)
    Set ganttRange = Intersect(wks2.UsedRange, wks2.columns("B:B").EntireColumn)

    listRows = listRange.Rows.count
    ganttRows = ganttRange.Rows.count

    If listRows > ganttRows Then 'sheet 1 has more rows, need to insert
        wks1.Range(wks1.Cells(listRows - (listRows - ganttRows), 1), wks1.Cells(listRows, 1)).EntireRow.Copy 
       wks2.Cells(ganttRows, 1).offset(1).PasteSpecial xlPasteValues
    ElseIf ganttRows > listRows 'sheet 2 has more rows need to delete
        wks2.Range(wks2.Cells(ganttRows, 1), wks2.Cells(ganttRows - (ganttRows - listRows), 1)).EntireRow.Delete
    End If

    Dim cel As Range
    'reset range because of updates
    Set ganttRange = Intersect(wks2.UsedRange, wks2.columns("B:B").EntireColumn)

    For Each cel In ganttRange
        If cel.Row Mod 2 = 0 Then cel.EntireRow.Interior.ColorIndex = 20
    Next

End Sub

UPDATE

更新

Just re-read this line

只需重新阅读这一行

If the user adds some more data to sheet1 then i need to insert some more rows at the end the data in sheet2 and if the user deletes some rows in sheet1 the rows are deleted from sheet2.

My solution is based on if the user insert / deletes rows at the bottom of the worksheet. If the user inserts / deletes rows in the middle, you are better off copy the entire range from sheet1 and onto a cleared out sheet2.

我的解决方案基于用户是否在工作表底部插入/删除行。如果用户在中间插入/删除行，最好将整个范围从 sheet1 复制到已清除的 sheet2 上。