Если у нас в ячейки оказывает число 5 или больше, то производиться звук. Я на форуме нашёл такой код:
[vba]
Код
Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Sub beeps(melody As String, Optional ByVal BeepTime As Integer = 200): mr = "qazwsxedcrfvtgbyhnujmik,ol.p;/['" ' If Not UCase(VBA.Environ(5)) Like "*IGORHOME*" Then If Not GRegB("EnableSound", az_Reg_Settings) Then Exit Sub For i = 1 To Len(melody) DoEvents nextlen = 1: letter = Mid$(melody, i, 1) nota = InStr(1, mr, letter) If IsNumeric(letter) And letter > 0 Then nextlen = letter: i = i + 1: nota = InStr(1, mr, Mid$(melody, i, 1))
If nota > 0 Then tone = 220 * (2 ^ ((nota - 1) / 12)): a = Beep(tone, nextlen * BeepTime) Else: a = Beep(30000, nextlen * BeepTime / 5) Next: End Sub
Sub beepH(): beeps "k", 100: End Sub Sub beepH0(): beeps "k", 30: End Sub Sub BeepH2(): beeps "k,k", 100: End Sub Sub beepL(): Beep 100, 100: End Sub Sub beepL0(): Beep 100, 30: End Sub Sub BeepL2(): Beep 100, 100: Beep 104, 100: Beep 100, 100: Beep 70, 200: End Sub Sub melody1(): speed = 150 beeps "5 5 3jnybt tybtftdx2d", speed: beeps "5 5 3jnybt tybtftdx2d", speed beeps "5 5 nnnyc3 ct2j nyc2 ty2btff ftf2t", speed: beeps "5 5 nnnyc3 ct2j nyc2 ty2btff ftf3 yb2t", speed End Sub Sub melody2(): speed = 250
Private Sub Worksheet_Calculate() If [a1] > 5 Then BeepH2 End Sub
[/vba]
Вот такую:
[vba]
Код
Private Sub Worksheet_Calculate() If [a1] > 5 Then BeepH2 If [a2] > 5 Then BeepH2 If [a3] > 5 Then BeepH2 If [a4] > 5 Then BeepH2 End Sub
[/vba]
И столкнулся с такой проблемой.
У меня изначально ячейки A1 A2 A3 A4 пустые. Представим что они заполняются: Например если в ячейки A1 число меньше 5-ти то звук не издаётся - ВСЁ ПРАВИЛЬНО, ПЕРЕХОДИМ К СЛЕДУЮЩЕЙ. Например если в ячейки A2 число меньше 5-ти то звук не издаётся - ВСЁ ПРАВИЛЬНО, ПЕРЕХОДИМ К СЛЕДУЮЩЕЙ. Например если в ячейки A3 число БОЛЬШЕ 5-ти то звук издаётся - ВСЁ ПРАВИЛЬНО, ПЕРЕХОДИМ К СЛЕДУЮЩЕЙ. А вот если в ячейки A4 число меньше 5-ти то звук ИЗДАЁТСЯ - А ВОТ ЭТО УЖЕ НЕ ПРАВИЛЬНО, нужно чтобы не издавался.
Как исправить код?
Если у нас в ячейки оказывает число 5 или больше, то производиться звук. Я на форуме нашёл такой код:
[vba]
Код
Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Sub beeps(melody As String, Optional ByVal BeepTime As Integer = 200): mr = "qazwsxedcrfvtgbyhnujmik,ol.p;/['" ' If Not UCase(VBA.Environ(5)) Like "*IGORHOME*" Then If Not GRegB("EnableSound", az_Reg_Settings) Then Exit Sub For i = 1 To Len(melody) DoEvents nextlen = 1: letter = Mid$(melody, i, 1) nota = InStr(1, mr, letter) If IsNumeric(letter) And letter > 0 Then nextlen = letter: i = i + 1: nota = InStr(1, mr, Mid$(melody, i, 1))
If nota > 0 Then tone = 220 * (2 ^ ((nota - 1) / 12)): a = Beep(tone, nextlen * BeepTime) Else: a = Beep(30000, nextlen * BeepTime / 5) Next: End Sub
Sub beepH(): beeps "k", 100: End Sub Sub beepH0(): beeps "k", 30: End Sub Sub BeepH2(): beeps "k,k", 100: End Sub Sub beepL(): Beep 100, 100: End Sub Sub beepL0(): Beep 100, 30: End Sub Sub BeepL2(): Beep 100, 100: Beep 104, 100: Beep 100, 100: Beep 70, 200: End Sub Sub melody1(): speed = 150 beeps "5 5 3jnybt tybtftdx2d", speed: beeps "5 5 3jnybt tybtftdx2d", speed beeps "5 5 nnnyc3 ct2j nyc2 ty2btff ftf2t", speed: beeps "5 5 nnnyc3 ct2j nyc2 ty2btff ftf3 yb2t", speed End Sub Sub melody2(): speed = 250
Private Sub Worksheet_Calculate() If [a1] > 5 Then BeepH2 End Sub
[/vba]
Вот такую:
[vba]
Код
Private Sub Worksheet_Calculate() If [a1] > 5 Then BeepH2 If [a2] > 5 Then BeepH2 If [a3] > 5 Then BeepH2 If [a4] > 5 Then BeepH2 End Sub
[/vba]
И столкнулся с такой проблемой.
У меня изначально ячейки A1 A2 A3 A4 пустые. Представим что они заполняются: Например если в ячейки A1 число меньше 5-ти то звук не издаётся - ВСЁ ПРАВИЛЬНО, ПЕРЕХОДИМ К СЛЕДУЮЩЕЙ. Например если в ячейки A2 число меньше 5-ти то звук не издаётся - ВСЁ ПРАВИЛЬНО, ПЕРЕХОДИМ К СЛЕДУЮЩЕЙ. Например если в ячейки A3 число БОЛЬШЕ 5-ти то звук издаётся - ВСЁ ПРАВИЛЬНО, ПЕРЕХОДИМ К СЛЕДУЮЩЕЙ. А вот если в ячейки A4 число меньше 5-ти то звук ИЗДАЁТСЯ - А ВОТ ЭТО УЖЕ НЕ ПРАВИЛЬНО, нужно чтобы не издавался.
Попробуйте использовать вместо события "Worksheet_Calculate", событие "Worksheet_Change". Это событие запускается, когда происходит изменение данных в какой-либо ячейке листа. Событие "Worksheet_Calculate" связано с формулами. Это событие запускается, когда изменяются данные, участвующие в формуле, при вставке формул (возможно и в других случаях). [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.CountLarge > 1 Then Exit Sub If Intersect(Target, Range("A1:A4")) Is Nothing Then Exit Sub If Target.Value > 5 Then BeepH2 End Sub
[/vba]
Попробуйте использовать вместо события "Worksheet_Calculate", событие "Worksheet_Change". Это событие запускается, когда происходит изменение данных в какой-либо ячейке листа. Событие "Worksheet_Calculate" связано с формулами. Это событие запускается, когда изменяются данные, участвующие в формуле, при вставке формул (возможно и в других случаях). [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.CountLarge > 1 Then Exit Sub If Intersect(Target, Range("A1:A4")) Is Nothing Then Exit Sub If Target.Value > 5 Then BeepH2 End Sub
Почему то звук не издаётся, если число не в ручную вписывается, а с помощью вычисления формул.
То есть скажем если я впишу в ячейку A1 число 7 то звук произведётся. А если в ячейку A1 впишет эксель, путём мною заполненных B1+C1=A1 Если я заполню B1 C1 и число A1 получится больше 5 то звук не будет издаваться.
Karataev! Спасибо да этот код работает!
Почему то звук не издаётся, если число не в ручную вписывается, а с помощью вычисления формул.
То есть скажем если я впишу в ячейку A1 число 7 то звук произведётся. А если в ячейку A1 впишет эксель, путём мною заполненных B1+C1=A1 Если я заполню B1 C1 и число A1 получится больше 5 то звук не будет издаваться.stalber
Сообщение отредактировал awaddwaawddw - Воскресенье, 17.12.2017, 16:58
Предполагается, что нужно работать со строками, начиная с 5, через 5 строк. [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.CountLarge > 1 Then Exit Sub If Target.Column <> Columns("AX").Column Then Exit Sub If Target.Row < 5 Then Exit Sub If Target.Row Mod 5 <> 0 Then Exit Sub If Target.Value > 5 Then BeepH2 End Sub
[/vba]
Вы это изменили: [vba]
Код
If Target.CountLarge > 1 Then Exit Sub
[/vba] Это означает, если изменение произошло не в одной ячейке, то выход из макроса. Если изменение произошло сразу в нескольких ячейках, то здесь надо уже как-то обрабатывать такую ситуацию. Поэтому оставьте здесь 1.
Предполагается, что нужно работать со строками, начиная с 5, через 5 строк. [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.CountLarge > 1 Then Exit Sub If Target.Column <> Columns("AX").Column Then Exit Sub If Target.Row < 5 Then Exit Sub If Target.Row Mod 5 <> 0 Then Exit Sub If Target.Value > 5 Then BeepH2 End Sub
[/vba]
Вы это изменили: [vba]
Код
If Target.CountLarge > 1 Then Exit Sub
[/vba] Это означает, если изменение произошло не в одной ячейке, то выход из макроса. Если изменение произошло сразу в нескольких ячейках, то здесь надо уже как-то обрабатывать такую ситуацию. Поэтому оставьте здесь 1.Karataev
Почему то звук не издаётся, если число не в ручную вписывается, а с помощью вычисления формул.
То есть скажем если я впишу в ячейку A1 число 7 то звук произведётся. А если в ячейку A1 впишет эксель, путём мною заполненных B1+C1=A1 Если я заполню B1 C1 и число A1 получится больше 5 то звук не будет издаваться.
Почему то звук не издаётся, если число не в ручную вписывается, а с помощью вычисления формул.
То есть скажем если я впишу в ячейку A1 число 7 то звук произведётся. А если в ячейку A1 впишет эксель, путём мною заполненных B1+C1=A1 Если я заполню B1 C1 и число A1 получится больше 5 то звук не будет издаваться.stalber
Почему то звук не издаётся, если число не в ручную вписывается, а с помощью вычисления формул.
Событие "Worksheet_Change" не запускается при пересчете формул. Для этого надо использовать событие "Worksheet_Calculate". Но в нем нельзя понять, какие формулы пересчитались.
Почему то звук не издаётся, если число не в ручную вписывается, а с помощью вычисления формул.
Событие "Worksheet_Change" не запускается при пересчете формул. Для этого надо использовать событие "Worksheet_Calculate". Но в нем нельзя понять, какие формулы пересчитались.Karataev
У меня все значения в столбце AX5, AX10, AX15... AX2000 И эти значения с помощью формул появляются. То есть я заполнил ячейки которые дали в сумме AX5 больше 5-ти и произвёлся звук. Через 10 минут я заполнил новые ячейки которые дали в сумме AX10 меньше 5-ти и звук не произвёлся Потом через 20 минут я заполнил новые ячейки которые дали в сумме AX15 больше 5-ти и звук снова произвёлся.
Цитата
Для этого надо использовать событие "Worksheet_Calculate". Но в нем нельзя понять, какие формулы пересчитались.
Есть решение или выхода нет?
По порядку: касаемо столбцов A это просто пример.
У меня все значения в столбце AX5, AX10, AX15... AX2000 И эти значения с помощью формул появляются. То есть я заполнил ячейки которые дали в сумме AX5 больше 5-ти и произвёлся звук. Через 10 минут я заполнил новые ячейки которые дали в сумме AX10 меньше 5-ти и звук не произвёлся Потом через 20 минут я заполнил новые ячейки которые дали в сумме AX15 больше 5-ти и звук снова произвёлся.
Цитата
Для этого надо использовать событие "Worksheet_Calculate". Но в нем нельзя понять, какие формулы пересчитались.
Новичку тяжело переделать пример под реальные данные, поэтому в темах описывайте реальные данные. Давайте заново. А то сейчас непонятно, про какие столбцы обсуждать.
Новичку тяжело переделать пример под реальные данные, поэтому в темах описывайте реальные данные. Давайте заново. А то сейчас непонятно, про какие столбцы обсуждать.Karataev
У меня все значения в столбце AX5, AX10, AX15...и так до... AX2000 И эти значения с помощью формул появляются, то есть я заполнил ячейки например C5+D5 которые дали в сумме больше 5-ти и появились в ячейке AX5 и произвёлся звук. Через 10 минут я заполнил новые ячейки C10+D10 которые дали в сумме меньше 5-ти и появились в ячейке AX10 звук не произвёлся. Потом через 20 минут я заполнил новые ячейки C15+D15 которые дали в сумме больше 5-ти и появились в ячейке AX15 и звук снова произвёлся.
Вот что мне нужно, от этой всей темы. Извиняюсь за изначально не корректно сформулированный вопрос в начале темы.
У меня все значения в столбце AX5, AX10, AX15...и так до... AX2000 И эти значения с помощью формул появляются, то есть я заполнил ячейки например C5+D5 которые дали в сумме больше 5-ти и появились в ячейке AX5 и произвёлся звук. Через 10 минут я заполнил новые ячейки C10+D10 которые дали в сумме меньше 5-ти и появились в ячейке AX10 звук не произвёлся. Потом через 20 минут я заполнил новые ячейки C15+D15 которые дали в сумме больше 5-ти и появились в ячейке AX15 и звук снова произвёлся.
Вот что мне нужно, от этой всей темы. Извиняюсь за изначально не корректно сформулированный вопрос в начале темы.stalber
awaddwaawddw, ну раз уж сюда перебрались, то сформулируйте задачу более четко. Вам нужно , чтоб при значении в одной из контролируемых ячеек сработало событие один раз. На мой взгляд, все просто, делам тригер который при первом совадении. В моем примере менять значения в столбце С. дабы калькуляцию запустить. [vba]
Код
Dim beepDone As Boolean
Private Sub Worksheet_Calculate() If [a1] > 5 Then If Not beepDone Then BeepH2: beepDone = True ElseIf [a2] > 5 Then If Not beepDone Then BeepH2: beepDone = True ElseIf [a3] > 5 Then If Not beepDone Then BeepH2: beepDone = True ElseIf [a4] > 5 Then If Not beepDone Then BeepH2: beepDone = True Else beepReady = False End If End Sub
[/vba]
awaddwaawddw, ну раз уж сюда перебрались, то сформулируйте задачу более четко. Вам нужно , чтоб при значении в одной из контролируемых ячеек сработало событие один раз. На мой взгляд, все просто, делам тригер который при первом совадении. В моем примере менять значения в столбце С. дабы калькуляцию запустить. [vba]
Код
Dim beepDone As Boolean
Private Sub Worksheet_Calculate() If [a1] > 5 Then If Not beepDone Then BeepH2: beepDone = True ElseIf [a2] > 5 Then If Not beepDone Then BeepH2: beepDone = True ElseIf [a3] > 5 Then If Not beepDone Then BeepH2: beepDone = True ElseIf [a4] > 5 Then If Not beepDone Then BeepH2: beepDone = True Else beepReady = False End If End Sub
Karataev прикрепил файл. Конечное число появляется в AX5 , AX10, AX15...
bmv98rus по вашему примеру, получается что только 1 раз издаться звук и всё, последующие разы уже звук не издаётся. В вашем примере я ввёл: в C1 цифру 3 звука нет. в C2 цифру 2 звука нет. в С3 цифру 7 звук есть. в С4 цифру 8 звука нет, а мне нужно чтобы был снова звук, так как цифры больше 5-ти.
Karataev прикрепил файл. Конечное число появляется в AX5 , AX10, AX15...
bmv98rus по вашему примеру, получается что только 1 раз издаться звук и всё, последующие разы уже звук не издаётся. В вашем примере я ввёл: в C1 цифру 3 звука нет. в C2 цифру 2 звука нет. в С3 цифру 7 звук есть. в С4 цифру 8 звука нет, а мне нужно чтобы был снова звук, так как цифры больше 5-ти.stalber
Dim Beep(1 To 4) As Boolean Private Sub Worksheet_Calculate() For I = 1 To 4 If Cells(I, 1) > 5 Then If Not Beep(I) Then BeepH2: Beep(I) = True: Exit For Else Beep(I) = False End If Next I End Sub
[/vba]
Сразу оговорю, если музыка отзвучала по ранее измененной ячейке, то снова не зазвучит если ячека опять >5.
[vba]
Код
Dim Beep(1 To 4) As Boolean Private Sub Worksheet_Calculate() For I = 1 To 4 If Cells(I, 1) > 5 Then If Not Beep(I) Then BeepH2: Beep(I) = True: Exit For Else Beep(I) = False End If Next I End Sub
[/vba]
Сразу оговорю, если музыка отзвучала по ранее измененной ячейке, то снова не зазвучит если ячека опять >5.bmv98rus
Dim Beep(1 To 4) As Boolean Private Sub Worksheet_Calculate() For I = 1 To 4 If Cells(I, 1) > 5 Then If Not Beep(I) Then BeepH2: Beep(I) = True: Exit For Else Beep(I) = False End If Next I End Sub
[/vba]
А как отредактировать код, у меня ячейки по которым ориентироваться: AX5, AX10, AX15... AX2000
bmv98rus да этот код работает!
[vba]
Код
Dim Beep(1 To 4) As Boolean Private Sub Worksheet_Calculate() For I = 1 To 4 If Cells(I, 1) > 5 Then If Not Beep(I) Then BeepH2: Beep(I) = True: Exit For Else Beep(I) = False End If Next I End Sub
[/vba]
А как отредактировать код, у меня ячейки по которым ориентироваться: AX5, AX10, AX15... AX2000stalber
Макрос запускается, когда пользователь вводит данные в столбцы "B:M". При этом макрос смотрит, в какие строки внесены изменения. В файле строки должны быть такие же, как в файле с примером. В группах (пример группы - строки 1:5) должно быть одинаковое кол-во строк. И между группами не должно быть пустых строк (как в файле с примером).
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Long If Target.CountLarge > 1 Then Exit Sub If Intersect(Target, Columns("B:M")) Is Nothing Then Exit Sub If (Target.Row - 3) Mod 5 = 0 Then r = Target.Row + 2 ElseIf (Target.Row - 4) Mod 5 = 0 Then r = Target.Row + 1 Else Exit Sub End If If IsError(Cells(r, "AX").Value) = False Then If Cells(r, "AX").Value > 5 Then BeepH2 End If End Sub
[/vba]
Макрос запускается, когда пользователь вводит данные в столбцы "B:M". При этом макрос смотрит, в какие строки внесены изменения. В файле строки должны быть такие же, как в файле с примером. В группах (пример группы - строки 1:5) должно быть одинаковое кол-во строк. И между группами не должно быть пустых строк (как в файле с примером).
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Long If Target.CountLarge > 1 Then Exit Sub If Intersect(Target, Columns("B:M")) Is Nothing Then Exit Sub If (Target.Row - 3) Mod 5 = 0 Then r = Target.Row + 2 ElseIf (Target.Row - 4) Mod 5 = 0 Then r = Target.Row + 1 Else Exit Sub End If If IsError(Cells(r, "AX").Value) = False Then If Cells(r, "AX").Value > 5 Then BeepH2 End If End Sub
Karataev спасибо, этот код работает, единственное при вводе данных в ячейки каждый раз выскакивает ошибка, которую можно игнорировать, но немного раздражает это окно каждый раз. Его как то убрать можно? Файл прикрепил. Ошибка: Microsoft Visual Basic: Run time error "13": type mismatch
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Long If Target.CountLarge > 1 Then Exit Sub If Intersect(Target, Columns("B:M")) Is Nothing Then Exit Sub If (Target.Row - 3) Mod 5 = 0 Then r = Target.Row + 2 ElseIf (Target.Row - 4) Mod 5 = 0 Then r = Target.Row + 1 Else Exit Sub End If If Cells(r, "AX").Value > 5 Then BeepH2 End Sub
[/vba]
bmv98rus спасибо, этот код работает, а как отредактировать код, у меня ячейки по которым ориентироваться: AX5, AX10, AX15... AX2000 [vba]
Код
Dim Beep(1 To 4) As Boolean Private Sub Worksheet_Calculate() For I = 1 To 4 If Cells(I, 1) > 5 Then If Not Beep(I) Then BeepH2: Beep(I) = True: Exit For Else Beep(I) = False End If Next I End Sub
[/vba]
Karataev спасибо, этот код работает, единственное при вводе данных в ячейки каждый раз выскакивает ошибка, которую можно игнорировать, но немного раздражает это окно каждый раз. Его как то убрать можно? Файл прикрепил. Ошибка: Microsoft Visual Basic: Run time error "13": type mismatch
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Long If Target.CountLarge > 1 Then Exit Sub If Intersect(Target, Columns("B:M")) Is Nothing Then Exit Sub If (Target.Row - 3) Mod 5 = 0 Then r = Target.Row + 2 ElseIf (Target.Row - 4) Mod 5 = 0 Then r = Target.Row + 1 Else Exit Sub End If If Cells(r, "AX").Value > 5 Then BeepH2 End Sub
[/vba]
bmv98rus спасибо, этот код работает, а как отредактировать код, у меня ячейки по которым ориентироваться: AX5, AX10, AX15... AX2000 [vba]
Код
Dim Beep(1 To 4) As Boolean Private Sub Worksheet_Calculate() For I = 1 To 4 If Cells(I, 1) > 5 Then If Not Beep(I) Then BeepH2: Beep(I) = True: Exit For Else Beep(I) = False End If Next I End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
