Для научной деятельности возникла необходимость написать макрос. Вспомнил университетские годы и написал, но он не считает необходимые данные. Точнее ничего не запускает. Хотя должен! Так что, уважаемые форумчане, прошу помочь найти ошибку. Код корявый до ужаса, сам понимаю, что-то не знал вообще как определить, поэтому вводил жуткие костыли, но пусть даже корявый - должен работать. 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
Ага, спасибо! Исправил, но он мне пишет type mismatch, сейчас буду разбираться в чем причина.
Во время возникновения ошибки появляется сообщение, щёлкните в этом сообщении кнопку "Debug", после этого отобразится VBA и строка с ошибкой будет закрашена жёлтым цветом. Эту строку нужно анализировать.
Кнопки debug не выдает. Может потому что у меня версия excel 2007?
[вложение удалено администратором]
Сообщения об ошибках разного вида, в каких-то нет кнопки "Debug". Если жёлтым не закрашено, то VBA должен перейти в место ошибки и выделить фрагмент, связанный с ошибкой. Этот фрагмент нужно анализировать, чтобы исправить ошибку.
Не выдавал все равно! Заменил 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
Только тогда начал указывать, не пойму почему так.
Выложите ваш код на форуме, я у себя его запущу.
Макрос
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" создана два раза и эта переменная выделена.
[вложение удалено администратором]
Все! Запустил! Спасибо вам, что подсказали, как правильно записывать переменные, а то я бы долго маялся. Запустил через функцию. Как присылал выше, потому что он все равно не выделял где ошибка. В итоге нашел, что ошибка в строке 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, у меня такое.
[вложение удалено администратором]
Нашёл закономерность. Такое окно, как у вас, появляется если процедура находится внутри модуля листа (я у вас на скрине увидел, что процедура находится в модуле листа). Если поместить процедуру в стандартный модуль, то будет так, как у меня на скриншотах.
Никогда раньше не задумывался об этом. Вообще, кладите макросы в стандартные модули. Модули листов и книг используйте, если есть в этом необходимость.