Excel VBA: Макрос по расчету суммы логарифмов, прошу помочь найти ошибку

[rudolfxcp]

Для научной деятельности возникла необходимость написать макрос. Вспомнил университетские годы и написал, но он не считает необходимые данные. Точнее ничего не запускает. Хотя должен! Так что, уважаемые форумчане, прошу помочь найти ошибку. Код корявый до ужаса, сам понимаю, что-то не знал вообще как определить, поэтому вводил жуткие костыли, но пусть даже корявый - должен работать. Excel 2007.
По большому счету мне нужно только последнее значение (sum) которое должно записываться в 4 столбец, остальные вычисления могут быть скрыты.

Спойлер

'Программа предназначена для расчета суммы логарифмов для большого массива данных которые размещаются во втором столбце
'около 4000 значений
'Изначально задается цикл который перебирает первые сто значений
'Каждое значение цикла вычитается из предыдущего и записываются для дальнейших вычислений
'Так же выписывается знак изменений (произошел рост значения или наобород упадок)
'После этого выбирается самая большая разность и делится на 100, в итоге получаем 100 ячеек (например 1000 поделить на 100
'получим 100 ячеек от 0 до 10, от 10 до 20, от 20 до 30 и т.д.
'Каждая разность в зависимости от размера будет попадать в одну из полученных в процессе деления ячеек
'Выписываем количество попавших в каждую ячейку разностей с учетом знака изменений (рост и упадок это
'две различных разности)
'Считаем логарифм от (полученного количества попаданий/100)*(количество разностей
'с положительным или отрицательным значением/100)
'считаем сумму логарифмов и выписываем получившееся значение в ячейку

Sub Макрос1()
Dim t, i, j, q, r, shag, minus, plus, p, byk, znak, medved, proh As Integer
Dim raznica, znach1, znach2, znach, sum As Double
shag = 100
raznica = 0
znach1 = 0
znach2 = 0
p = 1
prohod = 0
byk = 0
medved = 0
proh = 0
Do While p = 0 'делать пока не дойдем до пустого значения
        For i = 1 To shag 'этот цикл для того чтобы определить насколько было изменение значений и куда они двигались
            znach1 = Sheets("L3").Cells(1 + i + proh, 2) 'значение первое
            znach2 = Sheets("L3").Cells(2 + i + proh, 2) 'значение второе
            raznica = znach1 - znach2 'разница между первым и вторым значениями
                If raznica >= 0 Then znak = 0 Else znak = 1 'это значение запоминается чтобы определить знак (бык или медведь)
                If raznica >= 0 Then byk = byk + 1 Else medved = medved + 1 'эти значения определяют количество бычьих и медвежьх свечей
            raznica = Abs(raznica) 'Модуль разницы
            Sheets("L3").Cells(i, 30) = raznica 'выписываю разницу для дальнейшей работы
            Sheets("L3").Cells(i, 31) = znak 'выписываю знак разницы
        Next i
        t = Sheets("L3").Cells(1, 30) 'это значение и дальнейший цикл для определения наибольшего значения (разницы)
        minus = 0
        plus = 0
        For i = 1 To shag
            If Sheets("L3").Cells(i + 1, 30) > t Then t = Cells(i + 1, 30)
            If Sheets("L3").Cells(i, 31) = 1 Then minus = minus + 1 Else plus = plus + 1
        Next i
        q = t / shag 'делим наибольшее значение на количество шагов
        proh = proh + 1 'это для первого цикла, чтобы понять какой по счету набор проходит цикл
            For i = 1 To shag 'если p=0 значит цикл закончится, это цикл, чтобы прекратить счет если в следующем наборе шагов закончатся значения
                znach = Sheets("L3").Cells(1 + i + proh + shag, 2)
                    If znach = "" Then p = 0
            Next i
        For i = 1 To shag 'цикл для определения в какую ячейку попадают разность
            r = 0
                For j = 1 To shag
                    If Sheets("L3").Cells(i, 30) <= q * j Then r = j
                Next j
            Sheets("L3").Cells(i, 32) = r 'выписываем в какую ячейку попала разность
        Next i
        sum = 0
        For i = 1 To shag 'цикл для определения количества разностей попавших в одни и те же ячейки
            r = 0
            t = 0
                For j = 1 To shag
                    If Sheets("L3").Cells(j, 32) = i And Sheets("L3").Cells(j, 31) = 1 Then r = r + 1
                    If Sheets("L3").Cells(j, 32) = i And Sheets("L3").Cells(j, 31) = 0 Then t = t + 1
                Next j
            If r > 0 Then sum = sum + ((r * minus) / (2 * shag)) * Log((r * minus) / (2 * shag)) / Log(2) Else sum = sum
            If t > 0 Then sum = sum + ((t * plus) / (2 * shag)) * Log((t * plus) / (2 * shag)) / Log(2) Else sum = sum
        Next i
    Sheets("L3").Cells(proh + 1, 4) = sum
Loop
End Sub

[свернуть]

[Администратор]

Код ваш я не понимаю, просто ниже описал то, что бросилось в глаза.

Ошибка 1
В VBA, в отличии от других языков программирования, тип данных нужно указывать для каждой переменной. Если для переменной не указывать тип данных, то у неё будет тип данных "Variant". Правильно так:
Dim t As Integer, i As Integer, j As Integer, q As Integer, r As Integer, shag As Integer, minus As Integer, plus As Integer, p As Integer, byk As Integer, znak As Integer, medved As Integer, proh As Integer

Или если переменных очень много, чтобы улучшить читаемость кода, вместо фразы "As Integer" можно использовать символ "%":
Dim t%, i%, j%, q%, r%, shag%, minus%, plus%, p%, byk%, znak%, medved%, proh%

Ошибка 2
Сейчас уже нет смысла использовать тип данных "Integer", используйте всегда вместо него тип данных "Long". Integer имеет смысл использовать в макросах с большим кол-ва кода, чтобы уменьшить размер макроса. Для типа данных "Long" символ "&". Типа данных Integer вам может не хватить даже при работе с эксель-листом, т.к. сейчас на листе 1 млн. строк, а Integer работает только с числами около 32 тыс. Поэтому вообще забудьте про тип данных "Integer".

Ошибка 3
У вас нет входа в цикл Do ... Loop, т.к. вы записываете в переменную "p" 1. А цикл работает, если в переменной "p" 0.
Правильно так:
Do While p <> 0

[rudolfxcp]

Ага, спасибо! Исправил, но он мне пишет type mismatch, сейчас буду разбираться в чем причина.

[Администратор]

Во время возникновения ошибки появляется сообщение, щёлкните в этом сообщении кнопку "Debug", после этого отобразится VBA и строка с ошибкой будет закрашена жёлтым цветом. Эту строку нужно анализировать.

[rudolfxcp]

Кнопки debug не выдает. Может потому что у меня версия excel 2007?

[вложение удалено администратором]

[Администратор]

Сообщения об ошибках разного вида, в каких-то нет кнопки "Debug". Если жёлтым не закрашено, то VBA должен перейти в место ошибки и выделить фрагмент, связанный с ошибкой. Этот фрагмент нужно анализировать, чтобы исправить ошибку.

[rudolfxcp]

Не выдавал все равно! Заменил sub на Function ...
on error goto err_debug
lb_exit:
     Exit Function
err_debug:
     MsgBox Err.Number & ": " & Err.Description & " on line " & Erl, vbError
     resume lb_exit
End Function
Только тогда начал указывать, не пойму почему так.

[Администратор]

Выложите ваш код на форуме, я у себя его запущу.

[rudolfxcp]

Макрос

Sub Макрос1()
101 Dim i&, j&, r&, shag&, minus&, plus&, p&, byk&, znak&, medved&, proh&, m&
102 Dim raznica As Double
103 Dim q As Double 
104 Dim znach1 As Double
105 Dim znach2 As Double
106 Dim znach As Double
107 Dim sum As Double
108 Dim q As Double
109 Dim q As Double
110 shag = 100
111 raznica = 0
112 znach1 = 0
113 znach2 = 0
114 p = 1
115 prohod = 0
116 byk = 0
117 medved = 0
118 proh = 0
119 Do While p = 0 'делать пока не дойдем до пустого значения
120        For i = 1 To shag 'этот цикл для того чтобы определить насколько было изменение значений и куда они двигались
121            znach1 = Sheets("L3").Cells(1 + i + proh, 2) 'значение первое
122            znach2 = Sheets("L3").Cells(2 + i + proh, 2) 'значение второе
123            raznica = znach1 - znach2 'разница между первым и вторым значениями
124                If raznica >= 0 Then znak = 0 Else znak = 1 'это значение запоминается чтобы определить знак (бык или медведь)
125                If raznica >= 0 Then byk = byk + 1 Else medved = medved + 1 'эти значения определяют количество бычьих и медвежьх свечей
126            raznica = Abs(raznica) 'Модуль разницы
127            Sheets("L3").Cells(i, 30) = raznica 'выписываю разницу для дальнейшей работы
128            Sheets("L3").Cells(i, 31) = znak 'выписываю знак разницы
129        Next i
130        t = Sheets("L3").Cells(1, 30) 'это значение и дальнейший цикл для определения наибольшего значения (разницы)
131        minus = 0
132        plus = 0
133        For i = 1 To shag
134            If Sheets("L3").Cells(i + 1, 30) > t Then t = Cells(i + 1, 30)
135            If Sheets("L3").Cells(i, 31) = 1 Then minus = minus + 1 Else plus = plus + 1
136        Next i
137        q = t / shag 'делим наибольшее значение на количество шагов
138        proh = proh + 1 'это для первого цикла, чтобы понять какой по счету набор проходит цикл
139            For i = 1 To shag 'если p=0 значит цикл закончится, это цикл, чтобы прекратить счет если в следующем наборе шагов закончатся значения
140                znach = Sheets("L3").Cells(1 + i + proh + shag, 2)
141                    If znach = "" Then p = 0
142            Next i
143        For i = 1 To shag 'цикл для определения в какую ячейку попадают разность
144            r = 0
145                For j = 1 To shag
146                    If Sheets("L3").Cells(i, 30) <= q * j Then r = j
147                Next j
148            Sheets("L3").Cells(i, 32) = r 'выписываем в какую ячейку попала разность
149        Next i
150        sum = 0
151        For i = 1 To shag 'цикл для определения количества разностей попавших в одни и те же ячейки
152            r = 0
153            m = 0
154                For j = 1 To shag
155                    If Sheets("L3").Cells(j, 32) = i And Sheets("L3").Cells(j, 31) = 1 Then r = r + 1
156                    If Sheets("L3").Cells(j, 32) = i And Sheets("L3").Cells(j, 31) = 0 Then m = m + 1
157                Next j
158            If r > 0 Then sum = sum + ((r * minus) / (2 * shag)) * Log((r * minus) / (2 * shag)) / Log(2) Else sum = sum
159            If m > 0 Then sum = sum + ((m * plus) / (2 * shag)) * Log((m * plus) / (2 * shag)) / Log(2) Else sum = sum
160        Next i
161    Sheets("L3").Cells(proh + 1, 4) = sum
162 Loop
End Sub

[свернуть]

[Администратор]

У меня другое сообщение об ошибке. В этом сообщении говорится, что переменная "q" создана два раза и эта переменная выделена.

[вложение удалено администратором]

[rudolfxcp]

Все! Запустил! Спасибо вам, что подсказали, как правильно записывать переменные, а то я бы долго маялся. Запустил через функцию. Как присылал выше, потому что он все равно не выделял где ошибка. В итоге нашел, что ошибка в строке 141.
Я там писал вот так
znach = Sheets("L3").Cells(1 + i + proh + shag, 2)
                    If znach = "" Then p = 0
А исправил на If Sheets("L3").Cells(1 + i + proh + shag, 2) = "" Then p = 0

Спойлер

Sub Макрос1()
101 Dim i&, j&, r&, shag&, minus&, plus&, p&, byk&, znak&, medved&, proh&, m&
102 Dim raznica As Double
103 Dim znach1 As Double
104 Dim znach2 As Double
105 Dim znach As Double
106 Dim sum As Double
107 Dim q As Double
108 Dim t As Double
109 shag = 100
110 raznica = 0
111 znach1 = 0
112 znach2 = 0
113 znach = 0
114 p = 1
115 prohod = 0
116 byk = 0
117 medved = 0
118 proh = 0
119 Do While p <> 0
120        For i = 1 To shag 'этот цикл для того чтобы определить насколько было изменение значений и куда они двигались
121            znach1 = Sheets("L3").Cells(1 + i + proh, 2) 'значение первое
122            znach2 = Sheets("L3").Cells(2 + i + proh, 2) 'значение второе
123            raznica = znach1 - znach2 'разница между первым и вторым значениями
124                If raznica >= 0 Then znak = 0 Else znak = 1 'это значение запоминается чтобы определить знак (бык или медведь)
125                If raznica >= 0 Then byk = byk + 1 Else medved = medved + 1 'эти значения определяют количество бычьих и медвежьх свечей
126            raznica = Abs(raznica) 'Модуль разницы
127            Sheets("L3").Cells(i, 30) = raznica 'выписываю разницу для дальнейшей работы
128            Sheets("L3").Cells(i, 31) = znak 'выписываю знак разницы
129        Next i
130        t = Sheets("L3").Cells(1, 30) 'это значение и дальнейший цикл для определения наибольшего значения (разницы)
131        minus = 0
132        plus = 0
133        For i = 1 To shag
134            If Sheets("L3").Cells(i + 1, 30) > t Then t = Cells(i + 1, 30)
135            If Sheets("L3").Cells(i, 31) = 1 Then minus = minus + 1 Else plus = plus + 1
136        Next i
137        q = t / shag 'делим наибольшее значение на количество шагов
138        proh = proh + 1 'это для первого цикла, чтобы понять какой по счету набор проходит цикл
139            For i = 1 To shag 'если p=0 значит цикл закончится, это цикл, чтобы прекратить счет если в следующем наборе шагов закончатся значения
141                If Sheets("L3").Cells(1 + i + proh + shag, 2) = "" Then p = 0
142            Next i
143        For i = 1 To shag 'цикл для определения в какую ячейку попадают разность
144            r = 0
145                For j = 1 To shag
146                    If Sheets("L3").Cells(i, 30) <= q * j Then r = j
147                Next j
148            Sheets("L3").Cells(i, 32) = r 'выписываем в какую ячейку попала разность
149        Next i
150        sum = 0
151        For i = 1 To shag 'цикл для определения количества разностей попавших в одни и те же ячейки
152            r = 0
153            m = 0
154                For j = 1 To shag
155                    If Sheets("L3").Cells(j, 32) = i And Sheets("L3").Cells(j, 31) = 1 Then r = r + 1
156                    If Sheets("L3").Cells(j, 32) = i And Sheets("L3").Cells(j, 31) = 0 Then m = m + 1
157                Next j
158            If r > 0 Then sum = sum + ((r * minus) / (2 * shag)) * Log((r * minus) / (2 * shag)) / Log(2) Else sum = sum
159            If m > 0 Then sum = sum + ((m * plus) / (2 * shag)) * Log((m * plus) / (2 * shag)) / Log(2) Else sum = sum
160        Next i
161    Sheets("L3").Cells(proh + 1, 4) = sum
162 Loop
End Sub

[свернуть]

[Администратор]

Да, нестандартная у вас ситуация. Я сейчас вызвал ошибку Type Mismatch, у меня такое.

[вложение удалено администратором]

[Администратор]

Нашёл закономерность. Такое окно, как у вас, появляется если процедура находится внутри модуля листа (я у вас на скрине увидел, что процедура находится в модуле листа). Если поместить процедуру в стандартный модуль, то будет так, как у меня на скриншотах.
Никогда раньше не задумывался об этом. Вообще, кладите макросы в стандартные модули. Модули листов и книг используйте, если есть в этом необходимость.