简体   繁体   English

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

[英]Excel VBA to insert/delete rows at end of range

I need to insert or delete some rows depending on what a variable states. 我需要根据变量说明插入或删除一些行。

Sheet1 has a list of data. Sheet1有一个数据列表。 With sheet2 which is formatted, i want to copy that data so sheet2 is just a template and sheet1 is like a user form. 使用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

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. 如果用户在中间插入/删除行,则最好将整个范围从工作表1复制到已清除的工作表2上。

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM