代码之家 › 专栏 › 技术社区 › user4039065

故意在工作表上进行更改

excel-vba excel

4

user4039065 · 技术社区 · 8 年前

_{跳过我漫无目的的叙述,向下滚动到

tldr

和

Question

.}

我有几行和几列有值;例如A10:G15。在每一行中,任何单元格右侧的单元格值在所涉及列的范围内都依赖于该单元格。以这种方式,任何单元格右侧的单元格值在数字上总是大于单元格,如果原始单元格为空,则为空。

为了保持这种依赖性,如果我从a:f中的单元格中清除值,我想清除右边的任何值;如果我在a:f中的任何单元格中输入新值,我想逐步向右边的其余单元格添加随机数。

样本数据。左上角的7是A10。

    A    B     C     D     E     F     G
    7    12    15    19    23    27    28
    4     6    10    14    17    18    22
    8    10    14    18    23    26    31
    8    13    15    18    22    25    30
    8    13    16    18    19    21    24
    0     3     4     9    10    12    16

'similar data in A19:G22 and A26:G30

TLDR

▪如果我清除D12、E12:G12,也应清除。
▪如果我在C14中键入一个新值,那么d14:g14应该每个都收到一个新值,即
随机,但大于前一个值。
▪我可能希望在一列中清除或粘贴多个值,并希望
轮流处理每个问题的常规程序。
▪我有几个不相邻的区域(见代码示例中的联合范围)
下面)并且希望 DRY coding 风格。

Code

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    'Debug.Print Target.Address(0, 0)
    If Not Intersect(Target, Range("A10:F15, A19:F22, A26:F30")) Is Nothing Then
        Dim t As Range
        For Each t In Intersect(Target, Range("A10:F15, A19:F22, A26:F30"))
            If IsEmpty(t) Then
                t.Offset(0, 1).ClearContents
            ElseIf Not IsNumeric(t) Then
                t.ClearContents
            Else
                If t.Column > 1 Then
                    If t <= t.Offset(0, -1) Or IsEmpty(t.Offset(0, -1)) Then
                        t.ClearContents
                    Else
                        t.Offset(0, 1) = t + Application.RandBetween(1, 5)
                    End If
                Else
                    t.Offset(0, 1) = t + Application.RandBetween(1, 5)
                End If
            End If
        Next t
    End If

End Sub

Code explanation

此事件驱动的工作表“更改”处理已更改的每个单元格,但只直接向右修改该单元格,而不是该行中的其余单元格。保持剩余单元格的工作是通过保持事件触发器处于活动状态来完成的,这样当右侧的单个单元格被修改时,工作表更改将触发一个事件,该事件用新的目标调用自身。

问题

上面的程序似乎运行良好,尽管我做了最好/最坏的努力,但我还没有破坏我的项目环境。那么,如果可以将重复周期控制为有限的结果,那么故意在工作表上运行变更有什么问题呢?

2 回复 | 直到 8 年前

1

3

Franz 8 年前

Option Explicit
Const RANGE_STR As String = "A10:F15, A19:F22, A26:F30"

Private Sub Worksheet_Change(ByVal target As Range)
    Application.EnableEvents = False
        Dim t As Range
        If Not Intersect(target, Range(RANGE_STR)) Is Nothing Then
            For Each t In Intersect(target, Range(RANGE_STR))
                makeChange t
            Next t
        End If
    Application.EnableEvents = True
End Sub

Sub makeChange(ByVal t As Range)
    If Not Intersect(t, Range(RANGE_STR)) Is Nothing Then
        If IsEmpty(t) Then
            t.Offset(0, 1).ClearContents
            makeChange t.Offset(0, 1)
        ElseIf Not IsNumeric(t) Then
            t.ClearContents
            makeChange t
        Else
            If t.Column > 1 Then
                If t <= t.Offset(0, -1) Or IsEmpty(t.Offset(0, -1)) Then
                    t.ClearContents
                    makeChange t
                Else
                    t.Offset(0, 1) = t + Application.RandBetween(1, 5)
                    makeChange t.Offset(0, 1)
                End If
            Else
                t.Offset(0, 1) = t + Application.RandBetween(1, 5)
                makeChange t.Offset(0, 1)
            End If
        End If
    End If
End Sub

2

1

EvR 8 年前

  Const RANGE_STR As String = "A10:F15, A19:F22, A26:F30"

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MyArr As Variant, TargetR As Long, TargetC As Long, i As Long, ar As Range, myRow As Range
    Dim minC As Long, maxC As Long

    If Not Intersect(Target, Range(RANGE_STR)) Is Nothing Then

    minC = Range(RANGE_STR).Column 'taken form first area
    maxC = 1 + Range(RANGE_STR).Columns.Count 'taken form first area

    For Each ar In Target.Areas
        TargetC = ar.Column
            For Each myRow In ar.Rows
                TargetR = myRow.Row
                MyArr = Range(Cells(TargetR, minC), Cells(TargetR, maxC))
                If IsEmpty(MyArr(1, TargetC)) Or Not IsNumeric(MyArr(1, TargetC)) Then
                    For i = TargetC To UBound(MyArr, 2)
                        MyArr(1, i) = Empty
                    Next i
                Else
                    For i = TargetC + 1 To UBound(MyArr, 2)
                        MyArr(1, i) = MyArr(1, i - 1) + Application.RandBetween(1, 5)
                    Next i
                End If

                If Not Intersect(Range(Cells(TargetR, minC), Cells(TargetR, maxC)), Range(RANGE_STR)) Is Nothing Then
                Application.EnableEvents = False
                Range(Cells(TargetR, minC), Cells(TargetR, maxC)) = MyArr
                Application.EnableEvents = True
                End If
            Next myRow
    Next ar
    End If
    End Sub