当我在Private Sub Change中调用它时循环不起作用

Question

我写了这个长循环。如果我使用代码，因为它粘贴在（1）工作没有任何问题。循环代码基本上考虑了具有相似文本的多个列，并总结了另一列中数据的总值。正如我所说，（1）没有任何问题。

（1）

Private Sub Worksheet_Change(ByVal Target As Range)

Dim TestRow As Integer

Dim TestColumn As Integer

Dim Sum As Integer

TestRow = Target.Row

TestColumn = Target.Column

    If (TestColumn = 64) Then


        If (TestRow > 11) Then
            Sum = 0
            EColumnValue = 0
            FColumnValue = 0
            IColumnValue = 0
            APColumnValue = 0
            AQColumnValue = 0

            For i = TestRow To 11 Step -1

                If (i = TestRow) Then

                    Sum = ThisWorkbook.Sheets("New").Cells(TestRow, 64).Value
                    EColumnValue = ThisWorkbook.Sheets("New").Cells(TestRow, 5).Value
                    FColumnValue = ThisWorkbook.Sheets("New").Cells(TestRow, 6).Value
                    IColumnValue = ThisWorkbook.Sheets("New").Cells(TestRow, 9).Value
                    APColumnValue = ThisWorkbook.Sheets("New").Cells(TestRow, 42).Value
                    AQColumnValue = ThisWorkbook.Sheets("New").Cells(TestRow, 43).Value
                Else

                    If (EColumnValue = ThisWorkbook.Sheets("New").Cells(i, 5).Value) And (FColumnValue = ThisWorkbook.Sheets("New").Cells(i, 6).Value) And (IColumnValue = ThisWorkbook.Sheets("New").Cells(i, 9).Value) And (APColumnValue = ThisWorkbook.Sheets("New").Cells(i, 42).Value) And (AQColumnValue = ThisWorkbook.Sheets("New").Cells(i, 43).Value) Then
                        Sum = Sum + ThisWorkbook.Sheets("New").Cells(i, 64).Value

                        If (Sum > 100) Then
                            MsgBox "Similar values entered in columns E, F, I, AP and AQ equals more then 100"
                            MsgBox "Please re-enter the correct value in column BL"
                            ThisWorkbook.Sheets("New").Cells(TestRow, 64).Value = ""

                            End If
                    Else

                    End If
                End If
            Next

        End If
    End If

End Sub

相反，如果我在（2）中编写代码，则会收到错误“运行时错误424”。

Sub loopvba()

Dim TestRow As Integer
Dim TestColumn As Integer
Dim Sum As Integer

TestRow = Target.Row
TestColumn = Target.Column

    If (TestColumn = 64) Then


        If (TestRow > 11) Then
            Sum = 0
            EColumnValue = 0
            FColumnValue = 0
            IColumnValue = 0
            APColumnValue = 0
            AQColumnValue = 0

            For i = TestRow To 11 Step -1

                If (i = TestRow) Then

                    Sum = ThisWorkbook.Sheets("New").Cells(TestRow, 64).Value
                    EColumnValue = ThisWorkbook.Sheets("New").Cells(TestRow, 5).Value
                    FColumnValue = ThisWorkbook.Sheets("New").Cells(TestRow, 6).Value
                    IColumnValue = ThisWorkbook.Sheets("New").Cells(TestRow, 9).Value
                    APColumnValue = ThisWorkbook.Sheets("New").Cells(TestRow, 42).Value
                    AQColumnValue = ThisWorkbook.Sheets("New").Cells(TestRow, 43).Value
                Else

                    If (EColumnValue = ThisWorkbook.Sheets("New").Cells(i, 5).Value) And (FColumnValue = ThisWorkbook.Sheets("New").Cells(i, 6).Value) And (IColumnValue = ThisWorkbook.Sheets("New").Cells(i, 9).Value) And (APColumnValue = ThisWorkbook.Sheets("New").Cells(i, 42).Value) And (AQColumnValue = ThisWorkbook.Sheets("New").Cells(i, 43).Value) Then
                        Sum = Sum + ThisWorkbook.Sheets("New").Cells(i, 64).Value

                        If (Sum > 100) Then
                            MsgBox "Similar values entered in columns E, F, I, AP and AQ equals more then 100"
                            MsgBox "Please re-enter the correct value in column BL"
                            ThisWorkbook.Sheets("New").Cells(TestRow, 64).Value = ""

                            End If
                    Else

                    End If
                End If
            Next

        End If
    End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Call loopvba

End Sub

我不想使用第一个代码（1）的原因是因为在我的工作表中我有其他基于 Private Sub Worksheet_Change（ByVal Target As Range）的VBA代码。从此以后，我谷歌它，我发现你的工作表中不能有超过1 私人子工作表_更改（按目标范围）。

如何使我的循环代码集成并使用我在 Private Sub Worksheet_Change（ByVal Target As Range）下编写的其他vba代码。我在下面附上了一张照片，所以也许你更容易理解我的问题。感谢] 1

Answer 1

目标超出版本2中的loopvba范围。它需要作为预期参数传递。

Sub loopvba(ByRef Target As Range)

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

'code

    loopvba Target

'code

End Sub