Question

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

工作表1有一个数据列表。工作表2已经格式化, 我想复制数据, 所以工作表2 只是一个模板, 而工作表1 就像一个用户表。

直到循环的代码是获得第1页中仅包含数据的行数以及第2页中包含数据的行数。

如果用户在工作表1中添加了更多的数据,那么我需要在工作表2中的数据结尾处插入更多的行,如果用户删除工作表1中的一些行,则从工作表2中删除行。

我可以在每行上找到行数, 现在有多少行要插入或删除, 但那些行是不会被打开的。我将如何插入/ 删除正确的行数。我还想将行的颜色在白色和灰色之间进行交替。

我认为,删除工作表2 上的所有行,然后插入与工作表1 中相同数量的行,使用交替行的颜色,但是,我再次看到在有条件的格式中使用模式。

有人能帮忙吗?

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

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

如果用户在工作表底部插入/删除行,我的解决方案就基于此。如果用户在工作表底部插入/删除行。如果用户在工作表中间插入/删除行,您最好复制整个范围,从工作表1到清除的工作表2。

友情链接