Excel VBA在範圍末尾插入/刪除行

Question

根據變量的狀態，我需要插入或刪除一些行。

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 

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. 

我的解決方案是基於如果在工作表的底部，用戶插入/刪除行。如果用戶在中間插入/刪除行，則最好將整個範圍從sheet1複製到已清除的sheet2上。