Question

所以我有一个带有2列的excel表：Times和Count，以及3行：1：00、2：00和3:00 pm。我想要一种功能，当用户更改任何行的计数值时，应在下面添加计数值减去1行。因此，例如对于下面的1:00 pm，当用户输入“ 4”时，它应在该行下方添加三行，共4行。如果用户将计数更改为“ 2”，则应删除2行，以便共有2行。这是我到目前为止的内容：

Times              Count    
1:00pm               4         
2:00pm               0  
3:00pm               0

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Set KeyCells = Range("C5:C100")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
        'Save Workbook before so that original document will be saved
        ActiveWorkbook.Save
        Dim List As Long
        Dim i As Long
        Dim x As Long
        Dim ExCnt As Variant
        Dim aVal As Integer

        'Find how many rows contain data
         List = Range("B" & Rows.Count).End(xlUp).Row

        For i = List To 2 Step -1
            'Store exception value into variable
            ExCnt = Range("C" & i).Value

            With Range("C" & i)
                'Insert rows unless text says Exception Count
                If .Value > 1 And .Value <> "Exception Count" Then
                    .EntireRow.Copy
                    Application.EnableEvents = False

                    .Offset(1).EntireRow.Resize(.Value - 1).Insert
                End If

CleanExit:
            End With
        Next i

        Application.EnableEvents = True
    End If
End Sub

此代码为每行添加了正确的行数，但是如果用户更改计数值，则效果将对现有行产生复合作用。

Answer 1

我希望您能体会到这实际上是多么复杂。：-）

尝试此解决方案...

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim strKey As String, lngCount As Long, lngOffset As Long
    Dim i As Long, rngNewRows As Range, lngTopRow As Long, lngBottomRow As Long
    Dim bInBetween As Boolean

    ' Anymore than 10 cells and we'll skip this process.
    If Target.Cells.Count > 1 Then Exit Sub

    If Target.Column = 2 Then
        On Error Resume Next

        Err.Clear

        lngCount = Target.Value

        On Error GoTo 0

        If Err.Description = "" Then
            If lngCount = 0 Then lngCount = 1

            If lngCount > 0 Then
                ' Get the time value.
                strKey = Target.Offset(0, -1).Text

                bInBetween = False

                ' Check to make sure that the user isn't entering a value in between an already exploded set of rows.
                If Target.Row > 1 Then
                    If Target.Offset(-1, -1).Text = strKey Then bInBetween = True
                End If

                If Not bInBetween Then
                    lngOffset = 0

                    ' Now check each column below and delete or add rows depending on the count.
                    Do While True
                        lngOffset = lngOffset + 1
                        If Target.Offset(lngOffset, -1).Text <> strKey Then Exit Do
                    Loop

                    Application.EnableEvents = False

                    If lngOffset < lngCount Then
                        ' We need to add rows.
                        Set rngNewRows = Target.Worksheet.Rows(Target.Offset(lngOffset, 0).Row & ":" & Target.Offset(lngOffset, 0).Offset(lngCount - lngOffset - 1, 0).Row)

                        lngTopRow = rngNewRows.Cells(1, 1).Row
                        lngBottomRow = rngNewRows.Cells(rngNewRows.Rows.Count, 1).Row

                        rngNewRows.Insert

                        For i = lngTopRow To lngBottomRow
                            Target.Worksheet.Cells(i, Target.Column - 1) = Target.Offset(0, -1).Value
                        Next
                    Else
                        If lngOffset <> lngCount Then
                            ' We're over the count, determine the rows to delete.
                            Target.Worksheet.Rows(Target.Offset(lngCount, 0).Row & ":" & Target.Offset(lngOffset - 1, 0).Row).Delete
                        Else
                            ' We have 1 row and that's all that's been asked for.
                        End If
                    End If

                    Application.EnableEvents = True
                End If
            End If
        End If
    End If
End Sub

...您显然还有一些其他规则需要应用，但这应该可以助您一臂之力。看看下面的图片，看看它的效果。

几点...

它将尝试满足在爆炸范围内在B列中输入值的个人，如果他们这样做，它将不会对该值作出反应。不知道这是否是一个要求，但我认为是。
0将被视为1，因此将1，0和clear都清除将导致该行的重置。
删除发生在底部。因此，如果数字从10变为3，它将删除最后一组行以将其恢复为3。
一次更改仅会反应1个单元格。它降低了解决方案的复杂性。

除此之外，您是一个人。：-）

根据单元格值添加/删除行

1 个答案: