Question

每当单元格值在已定义的列中发生更改时，我都需要添加一个新行。然后我需要它为另一列做同样的事情，然后是另一列。

我使用了相同的代码三次，引用了不同的列，但我认为由于从第一次运行输入的新（空白）行而无效。我把它写成三个独立的Subs。

Sub LineTestCODE()

Dim lRow As Long
For lRow = Cells(Cells.Rows.Count, "C").End(xlUp).Row To 2 Step -1
    If Cells(lRow, "C") <> Cells(lRow - 1, "C") Then Rows(lRow).EntireRow.Insert
Next lRow    

End Sub


Sub LineTestENHANCEMENT()

Dim lRow2 As Long
For lRow2 = Cells(Cells.Rows.Count, "D").End(xlUp).Row To 2 Step -1
    If Cells(lRow2, "D") <> Cells(lRow2 - 1, "D") Then Rows(lRow2).EntireRow.Insert
Next lRow2

End Sub


Sub LineTestZONE()

Dim lRow3 As Long
For lRow3 = Cells(Cells.Rows.Count, "G").End(xlUp).Row To 2 Step -1
    If Cells(lRow3, "G") <> Cells(lRow3 - 1, "G") Then Rows(lRow3).EntireRow.Insert
Next lRow3   

End Sub

Answer 1

我不确定您要如何添加行。看起来好像要测试更改的单元格，如果它不匹配上面的单元格，请添加一行。我想你也可能希望在列中为每个不匹配的单元格对添加一行。您将在下面的代码中看到两者 - 选择。

我将此代码放在Sheet_Change事件中，但是如果您愿意，可以将其放在模块中并从此事件中调用它。您会看到我已禁用的活动，这可能是您的代码存在的问题。

此例程不会测试某人是否粘贴了值（即Target.Cells.Count＆gt; 1）。您可能希望处理Target是多个单元格的可能性。

For Each item in Target.Cells
    ..//..
Next

可能适合你。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MyColumns As Range

    ' Define the value columns we're interested in
    If MyColumns Is Nothing Then
        Set MyColumns = Union(Columns("C"), _
                              Columns("D"), _
                              Columns("G"))
    End If

    ' If you just want to add one row for a non-matching change in one of the three columns changes
    If Not Intersect(Target, MyColumns) Is Nothing Then
        If Target.Row > 1 Then
            If Target.Offset(-1).Value <> Target.Value Then
                Application.EnableEvents = False
                Target.Offset(1).EntireRow.Insert
                Application.EnableEvents = True
            End If
        End If
    End If

    ' If you want to add one row for each non-matching cell value in the three columns
    Dim cell As Range

    If Not Intersect(Target, MyColumns) Is Nothing Then
        If Target.Row > 1 Then
            For Each cell In Intersect(MyColumns, Target.EntireRow).Cells
                If cell.Offset(-1).Value <> cell.Value Then
                    Application.EnableEvents = False
                    cell.Offset(1).EntireRow.Insert
                    Application.EnableEvents = True
                End If
            Next
        End If
    End If

End Sub

单元格值更改时添加新行

1 个答案: