当单元格/范围中的值更改时执行过程

问题描述 投票:0回答:1

我是VBA的新手,并根据我的数据集编写了以下代码。如果将单元格/范围通过将新数据粘贴到工作表中而发生更改,则此处的目标是执行我的过程,很可能该工作表将为空,因为它将跟随一个清晰的内容过程。但是,该代码未触发更改事件,我已经尝试了Google的几种代码,但没有一个起作用。请注意,我的程序以所需的格式准确地获取了我想要的数据,但是,如果需要更改,请告诉我。

请帮助

1。更改事件触发器-存储在Sheet1

Private Sub Worksheet_Change(ByVal Target As Range)


If Not Intersect(Target, Me.Range("A1")) Is Nothing Then
        Application.EnableEvents = False
        Call LoopandIfStatement
        Application.EnableEvents = True

End If

End Sub

2。我的过程-存储在上述事件下方的Sheet1下

Sub LoopandIfStatement()


Dim SHT As Worksheet

Set SHT = ThisWorkbook.Worksheets("CB")

MyLr = SHT.Cells(Rows.Count, 1).End(xlUp).Row

Dim I As Long
For I = 1 To MyLr

Dim O As Long

Dim U As Range
Set U = SHT.Range("A" & I)

    If IsEmpty(SHT.Range("a" & I).Value) = False Then

        SHT.Range("k" & I).Value = SHT.Range("A" & I).Value

    Else

On Error GoTo ABC

        SHT.Range("k" & I).Value = U.Offset(-1, 0)

    End If

Next I

For O = 2 To MyLr

    If SHT.Range("g" & O).Value = "Closing Balance" Then

    SHT.Range("l" & O).Value = SHT.Range("j" & O).Value

      End If

  Next O

 ABC:

End Sub

Results

excel vba events
1个回答
0
投票

只要将新数据粘贴到列A到J的任何单元中,就会触发此操作>

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Me.Range("A:J")) Is Nothing Then

        Application.EnableEvents = False

        Call LoopandIfStatement

        Application.EnableEvents = True

    End If

End Sub

关于您的子LoopandIfStatement,这里有一些建议:

  1. 使用模块顶部的Option explicit(请参阅this
  2. 声明所有变量(您缺少:Dim MyLr as long
  3. 尝试将变量命名为易于理解的名称(例如,可以用MyLr代替lastRow
  4. 如果需要退出Sub,则可以使用Exit Sub代替Goto ABC

  5. 编辑:

为循环和更改工作表事件添加了代码。

将其粘贴到CB工作表模块的后面

一些重点:

  1. 当您在每个工作表更改上触发循环时,它将对所有单元格重新应用所有步骤。您可以使用Target事件中的Worksheet_Change参数/变量来处理更改的范围
  2. 要遍历现有范围,请参见AddAccountBalanceToRange过程
  3. 尝试按照可以分组的步骤或动作来思考和计划代码
  4. 使用评论描述您正在做的目的
  5. 记住要删除过时的代码(看到您在模块中有该过程的副本)

  6. Option Explicit
    
    Private Sub CommandButton1_Click()
        ThisWorkbook.Worksheets("Data").Columns("A:J").Copy
        ThisWorkbook.Worksheets("CB").Range("A:J").PasteSpecial Paste:=xlPasteValues
    End Sub
    
    Private Sub CommandButton2_Click()
        ThisWorkbook.Worksheets("CB").Range("A:L").ClearContents
    End Sub
    
    Private Sub Worksheet_Change(ByVal Target As Range)
    
        Dim targetUsedRange As Range
    
        ' Do something on non empty cells
        Set targetUsedRange = Intersect(Target, Target.Parent.UsedRange)
    
        If Not Intersect(Target, Me.Range("A:J")) Is Nothing Then
    
            Application.EnableEvents = False
    
            Call AddAccountBalance(targetUsedRange)
    
            Application.EnableEvents = True
    
        End If
    
    End Sub
    
    Private Sub AddAccountBalance(ByVal Target As Range)
    
        Dim targetSheet As Worksheet
        Dim evalRow As Range
    
        Dim lastColumn As Long
    
        Dim accountNumber As String
        Dim balanceString As String
        Dim narrative As String
        Dim balanceValue As Long
    
        balanceString = "Closing Balance"
    
        ' If deleting or clearing columns
        If Target Is Nothing Then Exit Sub
    
        ' Do something if there are any values in range
        If Application.WorksheetFunction.CountA(Target) = 0 Then Exit Sub
    
        ' Get the parent sheet of the cells that were modifid
        Set targetSheet = Target.Parent
    
        ' Get the last empty cell column in row 1 -Cells(3 -> this is row 3)- In the sample book: column K
        lastColumn = targetSheet.Cells(3, targetSheet.Columns.Count).End(xlToLeft).Column
    
        ' Loop through each of the rows that were modified in range
        For Each evalRow In Target.Cells.Rows
    
    
            ' Do something if account number or narrative are not null
            If targetSheet.Cells(evalRow.Row, 1).Value <> vbNullString Or targetSheet.Cells(evalRow.Row, 7).Value <> vbNullString Then
    
                ' Store columns values in evaluated row
                accountNumber = targetSheet.Cells(evalRow.Row, 1).Value
                narrative = targetSheet.Cells(evalRow.Row, 7).Value
                If IsNumeric(targetSheet.Cells(evalRow.Row, 10).Value) Then balanceValue = targetSheet.Cells(evalRow.Row, 10).Value
    
                ' Add account number
                If accountNumber <> vbNullString Then
                    targetSheet.Cells(evalRow.Row, lastColumn).Value = accountNumber
                End If
    
                ' Add closing balance
                If narrative = balanceString Then
                    targetSheet.Cells(evalRow.Row, lastColumn).Value = targetSheet.Cells(evalRow.Row, 1).Offset(-1, 0).Value
                    targetSheet.Cells(evalRow.Row, lastColumn).Offset(0, 1).Value = balanceValue
                End If
    
                ' Format last two columns (see how the resize property takes a single cell and expands the range)
                With targetSheet.Cells(evalRow.Row, lastColumn).Resize(, 2).Interior
                    .ThemeColor = xlThemeColorAccent6
                    .TintAndShade = 0.799981688894314
                    .PatternTintAndShade = 0
                End With
    
                ' Auto fit last column (K) (you could use the resize property as in the previous statement)
                targetSheet.Columns(lastColumn).EntireColumn.AutoFit
            End If
    
        Next evalRow
    
    End Sub
    
    Public Sub AddAccountBalanceToRange()
    
        Dim targetSheet As Worksheet
        Dim evalRange As Range
    
    
        Set targetSheet = ThisWorkbook.Worksheets("CB")
        Set evalRange = targetSheet.Range("A1:A42")
    
        AddAccountBalance evalRange
    
    End Sub
    
© www.soinside.com 2019 - 2024. All rights reserved.