Попытка вызвать Module Sub из Subheet Works: «Ошибка времени выполнения: 1004» - PullRequest
0 голосов
/ 27 сентября 2018

Я пишу некоторый код в VBA в Excel, который следует за этим процессом: он просматривает столбец E, пока не находит заголовок «Имя элемента», а затем просматривает столбец F, пока не найдет «Итого».Основываясь на этих двух местах, я могу суммировать общее количество (n) значений между ними.

Это было написано в модуле, и код для этого показан ниже:

Public Sub Sum()

Dim Sub_Total As Range
Dim Total As Range

   Set Item_Name = Sheets("Sheet1").Range("E:E").Find("Item Name")
   Set Sub_Total = Sheets("Sheet1").Range("F:F").Find("Sub Total")

   Range(Sub_Total.Address).Offset(0, 1) = Application.Sum(Range(Cells(Item_Name.Row + 1, 7), Cells(Sub_Total.Row - 1, 7)))

End Sub

Затем я хотел иметь функцию, которая могла бы определять, изменил ли пользователь значение в пределах области суммирования, и поэтому, если значение было изменено, оно снова суммировало бы все значения (снова просмотрите этот подпункт).

Я написал эту часть кода в коде Worksheet и он выглядит следующим образом:

Public Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range(Cells(Range("E:E").Find("Item Name").Row, 7), Cells(Range("F:F").Find("Sub Total").Row, 7))) Is Nothing Then

        Call Sum

    End If

End Sub

Я установил его так, что если пользователь изменил значение, он будет вызывать подпрограмму в модуле, который я создал ранее.

Однако всякий раз, когда я пытаюсь запустить этот код, я получаю сообщение об ошибке «Ошибка во время выполнения» 1004: ошибка приложения или объекта ».Когда я нажимаю «Отладка», он выделяет эту строку кода как проблему:

Set Item_Name = Sheets("Sheet1").Range("E:E").Find("Item Name")

Я пытался исследовать эту ошибку, а также много раз пытался решить эту проблему, но безрезультатно.Я чувствую, что это должно быть проблемой с вызывающей процедурой, потому что sub Sum () работает нормально, если она не вызывается в Sub рабочего листа.

Любые идеи или решения будут высоко оценены.Большое спасибо

Ответы [ 2 ]

0 голосов
/ 28 сентября 2018

Этот продолжал разъедать меня, поскольку поведение Экселя было таким странным.Этот код теперь работает для меня (вам не нужна другая подпрограмма).

Отключение событий не должно быть необходимым, но, похоже, оно имеет значение (и, как правило, рекомендуется в любом случае в этих обстоятельствах).

У вас также было Public Sub Worksheet_Change, которое, как я полагаю, вы напечатали от руки, тогда как оно должно быть Private (хотя я не знаю, какое это имеет значение).

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Sub_Total As Range
Dim Item_Name As Range

Application.EnableEvents = False

Set Item_Name = Range("E:E").Find("Item Name")
Set Sub_Total = Range("F:F").Find("Sub Total")

If Not Item_Name Is Nothing Then
    If Not Sub_Total Is Nothing Then
        If Not Intersect(Target, Range(Cells(Item_Name.Row, 7), Cells(Sub_Total.Row, 7))) Is Nothing Then
            Sub_Total.Offset(0, 1) = Application.Sum(Range(Cells(Item_Name.Row + 1, 7), Cells(Sub_Total.Row - 1, 7)))
        End If
    End If
End If

Application.EnableEvents = True

End Sub
0 голосов
/ 28 сентября 2018

Я бы изменил ваш код, изменив ваши переменные на Long и добавив .Row, он должен работать без проблем.Я также избавился от Offset, потому что вы знаете, в каком столбце вы хотите получить свой ответ. Вы всегда можете объявить две переменные как Public и использовать их в обоих макросах.

Dim Sub_Total As Long
Dim Item_Name As Long

   Item_Name = Sheets("Sheet1").Range("E:E").Find("Item Name").Row
   Sub_Total = Sheets("Sheet1").Range("F:F").Find("Sub Total").Row

   Cells(Sub_Total, 7).Value = Application.Sum(Range(Cells(Item_Name + 1, 7), Cells(Sub_Total - 1, 7)))

Ваш Worksheet_Changeможно написать так, если вы сделаете ваши переменные общедоступными ...

If Not Intersect(Target, Range(Cells(Item_Name, 7), Cells(Sub_Total, 7))) Is Nothing Then
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...