首页 文章

Excel VBA在范围结束时插入/删除行

提问于
浏览 次
0

我需要插入或删除一些行，具体取决于变量的状态 .

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

我的代码在for循环之前做的是获取表1中仅包含数据的行数以及sheet2中包含数据的行数 .

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

我可以获得每个行的行数，现在插入或删除多少行，但这就是我已经解开的地方 . 如何插入/删除正确的行数 . 此外，我想在白色和灰色之间交替行颜色 .

我确实认为删除sheet2上的所有行然后使用交替的行颜色插入sheet1中相同数量的行可能是一个想法但是我再次看到在条件格式中使用mod的一些事情 .

有人可以帮忙吗？

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
excel vba excel-vba insert conditional-formatting

1 回答

  • 1

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

    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

    重新阅读这一行

    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上 .

    回复于

相关问题