Выполнить процедуру при изменении значения в ячейке / диапазоне

Question

Я новичок в 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

Результаты

Answer 1

Это сработает всякий раз, когда новые данные вставляются в любую ячейку столбцов от 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

---

РЕДАКТИРОВАТЬ:

Добавлен код для l oop и события изменения листа.

Вставить его за CB Модуль листа

Некоторые основные моменты:

1. Когда вы активируете l oop на каждом изменении рабочего листа, все шаги будут повторно применены ко всем ячейкам. Вы можете работать с измененными диапазонами, используя аргумент / переменную Target в событии Worksheet_Change
2. Для l oop через существующий диапазон, см. Процедуру AddAccountBalanceToRange
3. Попробуйте подумать и планируйте свой код по шагам или действиям, которые можно сгруппировать
4. Используйте комментарии, чтобы описать цель того, что вы делаете
5. Не забудьте удалить устаревший код (если вы видели копию процедуры в модуле)

---

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