При изменении аргументов пользовательской функции вылетает Excel

@alexmosc · Регистрация: 14.10.2012

Студворк — интернет-сервис помощи студентам

Коллеги, добрый день!

Могли бы вы подсказать непрофессионалу в VBA, почему при изменении аргументов функции (полный код мой - приведен ниже) на листе Excel книга часто сразу же закрывается без указания конкретной причины сбоя.

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

Может я использую неправильную обработку данных в макросе?

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
Function тоталкоррел(x As Range) As Variant
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False
    Application.DisplayStatusBar = False
    Application.DisplayAlerts = False
 
'=тоталкоррел(диапазон)
 
Dim x1 As Variant
Dim x_marginal As String
Dim length As Long
Dim width As Long
Dim counter As Integer
Dim h As Long
Dim hh As Long
Dim hhh As Long
Dim hhhh As Long
Dim hhhhh As Long
Dim w As Long
Dim ww As Long
Dim x1_concatenated_collect As New Collection, a
Dim x1_marginal_collect As New Collection, b
Dim concatenated_probability As Double
Dim marginal_probability As Double
Dim totalcorrel As Double
 
x1 = x.Value
 
length = UBound(x1, 1)
 
width = UBound(x1, 2)
 
    'creating an array of concatenated elements
 
ReDim x1_concatenated(length, 1) As String
 
    For h = 1 To length
        For w = 1 To width
            x1_concatenated(h, 1) = x1_concatenated(h, 1) & x1(h, w)
        Next w
    Next h
 
    'creating a collection of concatenated elements
 
On Error Resume Next
    For Each a In x1_concatenated
        x1_concatenated_collect.Add a, Str(a)
    Next
 
    'creating an array of concatenated element probabilities
 
ReDim x1_concatenated_prob(x1_concatenated_collect.Count, 1) As Double
 
For h = 1 To x1_concatenated_collect.Count
    For hh = 1 To length
        If x1_concatenated(hh, 1) = x1_concatenated_collect(h) Then
            x1_concatenated_prob(h, 1) = x1_concatenated_prob(h, 1) + 1 / length
            Else
        End If
    Next hh
Next h
 
    'calculating big cyle
    
    For h = 1 To x1_concatenated_collect.Count
    
        marginal_probability = 1
        
        For counter = 1 To width
        
            x_marginal = Mid(x1_concatenated_collect(h), counter, 1)
            
            ReDim x1_marginal(length, 1) As String
            
            For hh = 1 To length
                x1_marginal(hh, 1) = x1(hh, counter)
            Next hh
            
            On Error Resume Next
            For Each b In x1_marginal
                x1_marginal_collect.Add b, Str(b)
            Next
            
            ReDim x1_marginal_prob(x1_marginal_collect.Count, 1) As Double
            
            For hhh = 1 To x1_marginal_collect.Count
                For hhhh = 1 To length
                    If x1_marginal(hhhh, 1) = x1_marginal_collect(hhh) Then
                        x1_marginal_prob(hhh, 1) = x1_marginal_prob(hhh, 1) + 1 / length
                        Else
                    End If
                Next hhhh
            Next hhh
            
            hhhhh = 1
            Do Until x_marginal = x1_marginal_collect(hhhhh) Or hhhhh = x1_marginal_collect.Count
                hhhhh = hhhhh + 1
            Loop
            
            marginal_probability = marginal_probability * x1_marginal_prob(hhhhh, 1)
            
        Next counter
                    
        totalcorrel = totalcorrel + x1_concatenated_prob(h, 1) * WorksheetFunction.Log(x1_concatenated_prob(h, 1) / marginal_probability, 2)
 
    Next h
 
тоталкоррел = totalcorrel
 
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True
    Application.DisplayStatusBar = True
    Application.DisplayAlerts = True
 
End Function

@alexmosc · 09.10.2014, 12:13 **[ТС]**

Файл с примером работы прилагаю.

SoftIce · 09.10.2014, 13:30

Сообщение от alexmosc

книга часто сразу же закрывается без указания конкретной причины сбоя.

Я код не смотрел, но если книга тихо умирает по неизвестной причине, то зачем вы выключаете алерты?

Visual Basic
1
Application.DisplayAlerts = False

@alexmosc · 09.10.2014, 13:50 **[ТС]**

Да, логично.

Попробовал убрать отключение алертов.

Все равно тихо вылетает книга. Скриншот прикрепил.

В общем, если объем обсчитываемых данных - маленький, например, 10 строк на 3 столбца, то все считается. Если там 1000 строк и значения в строки добавляются через другие формулы на листе, то изменение в аргументах используемых функций приводит к схлапыванию книги.

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

SoftIce · 09.10.2014, 14:53

On Error resume next тоже ясности не добавит.

@alexmosc · 09.10.2014, 15:45 **[ТС]**

О, убрал эту конструкцию и поведение изменилось. Теперь возвращает #ЗНАЧ!

Буду смотреть теперь дальше сам.

Спасибо.

Добавлено через 22 минуты
Применительно к указанной конструкции построения коллекции, этот рецепт я взял с форума:

Visual Basic
1
2
3
4
On Error Resume Next
    For Each a In x1_concatenated
        x1_concatenated_collect.Add a, Str(a)
    Next

И там же был комментарий относительно

Visual Basic
1
On Error Resume Next

"Worth adding (even at this late date) that Collections can be unique, as long as you use the second Key argument when adding items. Key values must always be unique, and adding an item with an existing Key raises an error:hence the On Error Resume Next"

(http://stackoverflow.com/quest... from-array)

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

SoftIce · 09.10.2014, 16:16

Сообщение от alexmosc

коллекция из уникальных значений собирается как раз правильно, когда обработка ошибки есть

Да, но ее действие распространяется на весь нижеследующий код. Нужно ли Вам это? Может лучше сделать так:

Visual Basic
1
2
3
4
5
On Error goto m
    For Each a In x1_concatenated
        x1_concatenated_collect.Add a, Str(a)
    Next
m:

@alexmosc · 09.10.2014, 16:51 **[ТС]**

А мне кажется при ошибке в моем оригинале программа продолжает с Next и соответственно идет на новый цикл. И если метку поставить после цикла, то собственно заполнение коллекции прервется при первом повторном элементе.

Но в целом, я понял, о чем Вы говорите. Конечно, такая обработка ошибки на весь код мне не нужна.

SoftIce · 09.10.2014, 17:42

Сообщение от alexmosc

заполнение коллекции прервется при первом повторном элементе.

Так?

Visual Basic
1
2
3
4
5
    For Each a In x1_concatenated
     On Error goto m
        x1_concatenated_collect.Add a, Str(a)
m:
    Next

@alexmosc · 09.10.2014, 19:06 **[ТС]**

Сегодня весь день копался, и слушал Вас, также.

Перепилил, в общем, код. Сделал не коллекцию, а dictionary. С коллекцией возникли дополнительные странности, когда попробовал ее заполнять текстовыми строками.

Попутно нашел баг серьъезный: теперь расчет можно проводить на текстовых строках, отрицательных цифрах и вообще любых значениях.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
    Option Explicit
    Option Base 1
 
Function тоталкоррел(x As Range) As Variant
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False
    Application.DisplayStatusBar = False
    'Application.DisplayAlerts = False
 
'=òîòàëêîððåë(äèàïàçîí)
 
Dim NumberOfRows As Long
Dim NumberOfColumns As Long
Dim x_marginal_array() As String
Dim x_marginal As String
Dim length As Long
Dim width As Long
Dim counter As Integer
Dim h As Long
Dim hh As Long
Dim hhh As Long
Dim hhhh As Long
Dim hhhhh As Long
Dim w As Long
Dim ww As Long
Dim concatenated_probability As Double
Dim marginal_probability As Double
Dim totalcorrel As Double
 
Dim d As New Scripting.Dictionary
Dim dd As New Scripting.Dictionary
Dim a As Variant
Dim aa As Variant
 
NumberOfRows = x.Rows.Count
NumberOfColumns = x.Columns.Count
 
ReDim x1(NumberOfRows, NumberOfColumns) As String
 
For h = 1 To NumberOfRows
    For w = 1 To NumberOfColumns
        x1(h, w) = CStr(x.Cells(h, w))
    Next w
Next h
 
length = UBound(x1, 1)
 
width = UBound(x1, 2)
 
    'creating an array of concatenated elements
 
ReDim x1_concatenated(length, 1) As String
 
    For h = 1 To length
        For w = 1 To width
            If w < width Then
                x1_concatenated(h, 1) = x1_concatenated(h, 1) & x1(h, w) & ";"
                Else
                x1_concatenated(h, 1) = x1_concatenated(h, 1) & x1(h, w)
            End If
        Next w
    Next h
 
    With d
        .CompareMode = TextCompare
        For Each a In x1_concatenated
            If Not Len(a) = 0 And Not .Exists(a) Then
                .Add a, Nothing
            End If
        Next a
    End With
 
    'creating an array of concatenated element probabilities
 
ReDim x1_concatenated_prob(d.Count, 1) As Double
 
For h = 1 To d.Count
    For hh = 1 To length
        If x1_concatenated(hh, 1) = d.keys(h - 1) Then
            x1_concatenated_prob(h, 1) = x1_concatenated_prob(h, 1) + 1 / length
            Else
        End If
    Next hh
Next h
 
    'calculating big cyle
    
    For h = 1 To d.Count
        
        x_marginal_array = Split(d.keys(h - 1), ";")
        
        marginal_probability = 1
        
        For counter = 1 To width
            
            x_marginal = x_marginal_array(counter - 1)
            
            ReDim x1_marginal(length, 1) As String
            
            For hh = 1 To length
                x1_marginal(hh, 1) = x1(hh, counter)
            Next hh
            
            With dd
                .CompareMode = TextCompare
                For Each aa In x1_marginal
                    If Not Len(aa) = 0 And Not .Exists(aa) Then
                        .Add aa, Nothing
                    End If
                Next aa
            End With
            
            ReDim x1_marginal_prob(dd.Count, 1) As Double
            
            For hhh = 1 To dd.Count
                For hhhh = 1 To length
                    If x1_marginal(hhhh, 1) = dd.keys(hhh - 1) Then
                        x1_marginal_prob(hhh, 1) = x1_marginal_prob(hhh, 1) + 1 / length
                        Else
                    End If
                Next hhhh
            Next hhh
            
            hhhhh = 1
            Do Until x_marginal = dd.keys(hhhhh - 1) Or hhhhh = dd.Count
                hhhhh = hhhhh + 1
            Loop
            
            marginal_probability = marginal_probability * x1_marginal_prob(hhhhh, 1)
            
        Next counter
                    
        totalcorrel = totalcorrel + x1_concatenated_prob(h, 1) * WorksheetFunction.Log(x1_concatenated_prob(h, 1) / marginal_probability, 2)
 
    Next h
 
тоталкоррел = totalcorrel
 
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True
    Application.DisplayStatusBar = True
    'Application.DisplayAlerts = True
 
End Function

Пока не разу не вылетела книга. Щас еще потестирую.

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Web (WebAssembly): Идентификация объектов на Box2D v3 - использование userData и событий коллизий 8Observer8 02.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-collision-events-sdl3-c. zip https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11680&d=1772460536 Одним из. . .	Реалии Hrethgir 01.03.2026 Нет, я не закончил до сих пор симулятор. Эта задача сложнее. Не получилось уйти в плавсостав, но оно и к лучшему, возможно. Точнее получалось - но сварщиком в палубную команду, а это значит, в моём. . .	Ритм жизни kumehtar 27.02.2026 Иногда приходится жить в ритме, где дел становится всё больше, а вовлечения в происходящее — всё меньше. Плотный график не даёт вниманию закрепиться ни на одном событии. Утро начинается с быстрых,. . .	SDL3 для Web (WebAssembly): Сборка библиотек: SDL3, Box2D, FreeType, SDL3_ttf, SDL3_mixer и SDL3_image из исходников с помощью CMake и Emscripten 8Observer8 27.02.2026 Недавно вышла версия 3. 4. 2 библиотеки SDL3. На странице официальной релиза доступны исходники, готовые DLL (для x86, x64, arm64), а также библиотеки для разработки под Android, MinGW и Visual Studio. . . .
SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .	Конвертировать закладки radiotray-ng в m3u-плейлист damix 19.02.2026 Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .	Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI Eddy_Em 18.02.2026 Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .

@alexmosc 4 / 4 / 1 Регистрация: 14.10.2012 Сообщений: 95
	09.10.2014, 13:50 [ТС]
	Да, логично. Попробовал убрать отключение алертов. Все равно тихо вылетает книга. Скриншот прикрепил. В общем, если объем обсчитываемых данных - маленький, например, 10 строк на 3 столбца, то все считается. Если там 1000 строк и значения в строки добавляются через другие формулы на листе, то изменение в аргументах используемых функций приводит к схлапыванию книги. При этом если числа в массиве заданы простой функцией, например, случмежду(), то все считается нормально даже на больших массивах. Миниатюры 0

SoftIce es geht mir gut 11274 / 4760 / 1183 Регистрация: 27.07.2011 Сообщений: 11,439
	09.10.2014, 14:53
	On Error resume next тоже ясности не добавит. 0

@alexmosc 4 / 4 / 1 Регистрация: 14.10.2012 Сообщений: 95
	09.10.2014, 16:51 [ТС]
	А мне кажется при ошибке в моем оригинале программа продолжает с Next и соответственно идет на новый цикл. И если метку поставить после цикла, то собственно заполнение коллекции прервется при первом повторном элементе. Но в целом, я понял, о чем Вы говорите. Конечно, такая обработка ошибки на весь код мне не нужна. 0