Excel VBA 一定の数値以下で音を鳴らす

質問

一つのセル内の数値（VBAにより、1秒ごとに更新される流動的な数値です）において、-2以下になるとすぐにBEEＰ音が鳴る設定をしたいのですが、何故か１分ごとにしか鳴りません。
今のモジュールは、標準モジュールに

Public Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

Sheet1に

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
If Range("Q6") < -2 Then
Call Beep(2000, 500)
Call Beep(2000, 500)
End If
End If
End Sub

と入力しています。

改善方法をどうかご教授願います。

回答No.10

kkkkkm · ベストアンサー

CommandButton2かどうかは分かりませんが以下のようにしてください。
今回、Callはなくてもいけると思いますが、無いと駄目な場合もありますのでその時のためにCallも覚えておいてください。
Private Sub CommandButton2_Click()
Call 急騰急落告知
Call 急騰急落
End Sub

お礼

できました。本当に助かりました。
いままで本当にありがとうございました。
もっと自分でも何とか改善できるよう勉強していきます。

回答No.9

kkkkkm

No1
1秒ごとにA列のデータを更新しているのでしょうか。数式ではなくてです。

No3
ここに1秒ごとに更新されるセルもしくは列か行を指定してください。

これが前提です。これがないのでしたら話は変わります。
これがないのでしたら
Sub 急騰急落告知()があるModule1に(Q6は適宜変更してください)
以下のコードを追加して実行してください。ただし、他の動作とバッティングして正常に動くかどうかは分かりません。

Sub 急騰急落()
If Range("Q6") < -2 Then
Call Beep(2000, 500)
Call Beep(2000, 500)
End If
Application.OnTime Now + TimeValue("00:00:01"), "急騰急落"
End Sub

上記にしてWorksheet_Changeは不要です。

Worksheet_Changeはネットで検索するなどしてしてその動作を理解してください。
分かっていないのに中身を適当に変更しても思うようには動きません。

補足

音が１秒ごとになるようになりました！ありがとうございます。
最後に可能でしたら、現在手動で起動するマクロが2つあり、
１分前の株価を表示するものと先ほどの１秒ごとにアラームかなるものがあります。
Sub 急騰急落告知()

Range("E1:E300").Copy

Range("F1:F300").PasteSpecial Paste:=xlPasteValues

Application.OnTime Now + TimeValue("00:01:00"), "急騰急落告知", Now + TimeValue("00:02:00")

End Sub

Sub 急騰急落()
If Range("L1") < -2 Then　←該当セルをL1にしましたが気にしないでください
Call Beep(2000, 500)
Call Beep(2000, 500)
End If
Application.OnTime Now + TimeValue("00:00:01"), "急騰急落"
End Sub
これを一つのボタン起動ですることはできますでしょうか？（DirectXのボタン）
できなければメニューの「開発」内の「マクロ」の項目を１つにできたらなと思います。
最後の質問になりますが、よろしくお願いいたします。

回答No.8

kkkkkm

> 標準モジュール3に
> Private Sub Worksheet_Change(ByVal Target As Range)
> Range("O1").Value = Range("M1").Value
> End Sub

Worksheet_Changeはそのコードが書かれているシートのセルを編集し終わったときに実行されます。
なので標準モジュールに記載しても意味がありません。

また、セルにデータを入れたらWorksheet_Changeは実行されるので、データを入れたら実行されるWorksheet_Changeを実行するためにWorksheet_Changeで代入しようとするのは堂々巡りですし、場合によっては永久ループになります。

1秒に一度変更されるのはどのセルですかそのセルを以下のO1のところに指定してください。
If Target.Address = Range("O1").Address Then

RSSについては私にはその動作はわかりませんので、そこは無視した状態での回答になっています。

補足

Private Sub Worksheet_Change(ByVal Target As Range)
Range("O1").Value = Range("M1").Value
End Sub
を
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("O1").Address Then
If Target < -2 Then
Call Beep(2000, 500)
Call Beep(2000, 500)　※Range("O1").Valueはミスタッチです
End If
End If
End Subと同じところに入れようとすると、Private Sub Worksheet_Change(ByVal Target As Range)の部分が重なってかエラーになります。

あと、単体でPrivate Sub Worksheet_Change(ByVal Target As Range)
Range("O1").Value = Range("M1").Value
End Subを入力しても、O1のセルに何も反映されませんでした。完全に行き詰っています。
（そもそもIf Target.Address = Range("L1").Address Then
If Target < -2 Thenの部分を「値のみ対象にすればいいと思い。Range（”M1”）.Value」にしてもだめでした）
基本的なことかもしれませんがご教授願います。。。

ちなみに楽天RSSは1秒ごとに自動で銘柄名称・売買代金・現在値が更新されます。

回答No.7

kkkkkm

> Offset(0, 1).Value = "=RSS|'" & code & ".TJ'!銘柄名称""
> .Offset(0, 2).Value = "=RSS|'" & code & ".TJ'!現在値ティック"
> .Offset(0, 3).Value = "=RSS|'" & code & ".TJ'!売買代金"""
> .Offset(0, 4).Value = "=RSS|'" & code & ".TJ'!現在値"
> が黄色くなりエラーになります。

回答に貼り付けしたときに「"」が最後に余分についたみたいです。各行の最後の「"」は一個にしてください。元の"=RSS・・・"の部分をコピペしたら間違いがないです。

> Private Sub Worksheet_Change(ByVal Target As Range)
> If Target.Address = Range("該当のセルの範囲です").Address Then

セルの範囲ではなく同時にその範囲が変更されるのならどれかセル一個にしてください。

一秒ごとに範囲のどれかのセルが更新されるのなら(範囲がX3:X9としたら)
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("X3:X9")) Is Nothing Then

補足

一括登録はできました。ありがとうございます。
音の件ですが、H1～H300に「証券会社から取得したセル」を元に計算した「１分前の株価との騰落率」が入っており、M1に「その比率で一番小さい数字」が来るように数式が入っております。（=VLOOKUP(1,$A$1:$H$300,8,FALSE)
M1に上記数式が入っていると、随時ブザーが鳴らないということで、
標準モジュール3に
Private Sub Worksheet_Change(ByVal Target As Range)
Range("O1").Value = Range("M1").Value
End Sub
を記載し、ブザーを対象とするセルを別にO1に設けました。
（M1と値は同じですが数式を入れないため）その後
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("O1").Address Then
If Target < -2 Then
Call Beep(2000, 500)
Call Beep(2000, 500)Range("O1").Value
End If
End If
End Sub
を入力し、マクロを実行してもO1に値が反映されません。。
間違っている個所はどこになりますでしょうか？

回答No.6

kkkkkm

> 急騰急落告知プロシージャ内に
> Private Sub Worksheet_Change(ByVal Target As Range)
> If Target.Column = 1 Then
> If Range("Q6") < -2 Then
> と追加入力すればいいのでしょうか？

すみせんが何をもってそのような解釈になるのか意味が分かりません。

補足

株価の動いている時などで、けんしょうしたのですが、まず
Private Sub mGetData()内の

.Offset(0, 1).Value = "=RSS|'" & code & ".TJ'!銘柄名称""
.Offset(0, 2).Value = "=RSS|'" & code & ".TJ'!現在値ティック"
.Offset(0, 3).Value = "=RSS|'" & code & ".TJ'!売買代金"""
.Offset(0, 4).Value = "=RSS|'" & code & ".TJ'!現在値"
が黄色くなりエラーになります。
あと、音の部分ですが、
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("該当のセルの範囲です").Address Then
If Target < -2 Then
Call Beep(2000, 500)
Call Beep(2000, 500)
End If
End If
End Sub
に変更しましたが、うまくいきません。。
また、http://masudahp.web.fc2.com/vb6/vb6api/vb6api01.htmlを参照にし、マネージャーを開くも、何も入っていませんでした。。。

回答No.5

kkkkkm

コードの場所はそのままで

> もしよろしければ、非常に面倒かとと思いますが、1から入力の仕方『どのモジュールにどんな式で入れればいいか』教えていただけると助かります、、

「別のセルにおいて証券会社から１秒ごとに取得した値」が更新される(数式ではなく実際にデータを代入する)セルがX1だとしたら

If Target.Column = 1 Then
を
If Target.Address = Range("X1").Address Then

> あと銘柄登録ボタンも一括登録する事が可能ならば教えていただきたいです、、、

295銘柄がA1からA295まで連続してあるとしたら
'1行ずらすとありますが実際のコードは1列ずれていってます。
現状のコードをいかし、Selectは省いて一部変更しています。

Private Sub CommandButton1_Click()
Dim c As Range
Application.ScreenUpdating = False
For Each c In Range("A1:A295")
c.Activate
mGetData
Next
Application.ScreenUpdating = True
End Sub

Private Sub mGetData()
Dim a_col As Long, a_row As Long, code As String
a_col = ActiveCell.Column
a_row = ActiveCell.Row
code = Cells(a_row, a_col).Value
If code <> "" Then
With Cells(a_row, a_col)
.Offset(0, 1).Value = "=RSS|'" & code & ".TJ'!銘柄名称""
.Offset(0, 2).Value = "=RSS|'" & code & ".TJ'!現在値ティック"
.Offset(0, 3).Value = "=RSS|'" & code & ".TJ'!売買代金""
.Offset(0, 4).Value = "=RSS|'" & code & ".TJ'!現在値"
End With
End If
End Sub

補足

少しでも現状をシンプルにするために余分なセルを削除しました。
銘柄コードの入力セルをA1からA300に変更（監視数も295から300にしました）
Sheet1コードが
Private Sub CommandButton1_Click()
Dim c As Range
Application.ScreenUpdating = False
For Each c In Range("A1:A300")
c.Activate
mGetData
Next
Application.ScreenUpdating = True
End Sub

Private Sub mGetData()
Dim a_col As Long, a_row As Long, code As String
a_col = ActiveCell.Column
a_row = ActiveCell.Row
code = Cells(a_row, a_col).Value
If code <> "" Then
With Cells(a_row, a_col)
.Offset(0, 1).Value = "=RSS|'" & code & ".TJ'!銘柄名称"""
.Offset(0, 2).Value = "=RSS|'" & code & ".TJ'!現在値ティック"
.Offset(0, 3).Value = "=RSS|'" & code & ".TJ'!売買代金"""
.Offset(0, 4).Value = "=RSS|'" & code & ".TJ'!現在値"
End With
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("G1:G300").Address Then
If Target < -2 Then
Call Beep(2000, 500)
Call Beep(2000, 500)
End If
End If
End Sub

H列にRANK関数を移動しました。
Module1コードも

Sub 急騰急落告知()
Range("I7").Value = Now
Range("J7").Value = Now + TimeValue("00:01:00")
Range("E1:E300").Copy
Range("F1:F300").PasteSpecial Paste:=xlPasteValues
Application.OnTime Now + TimeValue("00:01:00"), "急騰急落告知", Now + TimeValue("00:02:00")
End Sub
に修正しました。

回答No.4

kkkkkm

No3の
急騰急落告知()が再起呼び出しの件
は勘違いですので無視してください。

補足

ありがとうございます。
本当に素人ですみませんが、最近VBAをかじった程度で、VBAの他の人のを参考にして我流でやっただけなので、ほとんど理解できてません、、
もしよろしければ、非常に面倒かとと思いますが、1から入力の仕方『どのモジュールにどんな式で入れればいいか』教えていただけると助かります、、
あと銘柄登録ボタンも一括登録する事が可能ならば教えていただきたいです、、、

回答No.3

kkkkkm

Sub 急騰急落告知()

これで1秒に1度A1のデータを更新してますので

Private Sub Worksheet_Change(ByVal Target As Range)

このChangeイベントの

If Target.Column = 1 Then

が真になって(.Columnの 1　はA列)

If Range("Q6") < -2 Then
以降が1秒ごとに実施されていると思われます。

ですので

If Target.Column = 1 Then

ここに1秒ごとに更新されるセルもしくは列か行を指定してください。
「別のセルにおいて証券会社から１秒ごとに取得した値」が更新されるセル
を指定すればいいのではないでしょうか。

あと
急騰急落告知()
が再起呼び出しになっていますが
Application.OnTimeで呼び出すモジュール(セルに記載する部分)は別にした方がいいような気もします。

補足

急騰急落告知プロシージャ内に
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
If Range("Q6") < -2 Then
と追加入力すればいいのでしょうか？

回答No.2

imogasi

Column = 1 すなわちA列の、どれかの行かのセルの値が変化したとき、このイベント（If Range("Q6") < -2 Then以下）が実行されますが、それと判別に用いている、セルQ6との関係はどうなっているのですか。
A列の変化ーー＞Q６セルの値変化が巻数などで変化するのか、
Q６セルも、システムから入るデータで変化するのか、
よくわからないのだが。
＝＝＝＝＝＝
標準モジュールに（API関数は標準モジュールに置くのだと思うが）
ーー
http://masudahp.web.fc2.com/vb6/vb6api/vb6api01.html
＞標準モジュールにコピーする。
ーー
Public Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
ーー
Sheet1のシートモジュールで、Changeイベントを指定し、
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
If Target < -2 Then　　’＜－－ここを質問とは変えてやってみた
Call Beep(2000, 500)
Call Beep(2000, 500)
End If
End If
End Sub
でA列に（小生のテストで、キーボードより）－２３など入れると、２回ピーピーなりましたが。
＝＝
関係ない、のかもしれないが、システムが更新するのは、下の空白行に、新しいデータを追加していくのではないのですか？
株銘柄の株価ボードのように、銘柄により表示位置が決まっていて、そこが随時値が変わるのか、スつ問では、く説明が必要ではないか？

補足

すみません、明日の昼まで仕事ですので、また明日調べて返信しますので、少しお待ち下さい！
申し訳ないです。。

回答No.1

kkkkkm

1秒ごとにA列のデータを更新しているのでしょうか。数式ではなくてです。

補足

素人ですみません。。一からの説明になりますが、まず295銘柄の情報を取得するために、
同シート内に一覧表を作り、セルに銘柄番号を入力しボタン押下すると各情報が表示されるようにします（今は１銘柄ずつボタン押下することにより取得できますが、300近く押下する必要があり、本当はワンクリックで一括入力できるようにしたいんです。。
Sheet1に
Private Sub CommandButton1_Click()
a_col = ActiveCell.Column
a_row = ActiveCell.Row
code = Cells(a_row, a_col).Value
If code <> "" Then
Selection.Offset(0, 1).Select '1行ずらす
Selection.Value = "=RSS|'" & code & ".TJ'!銘柄名称"
Selection.Offset(0, 1).Select '1行ずらす
Selection.Value = "=RSS|'" & code & ".TJ'!現在値ティック"
Selection.Offset(0, 1).Select '1行ずらす
Selection.Value = "=RSS|'" & code & ".TJ'!売買代金"
Selection.Offset(0, 1).Select '1行ずらす
Selection.Value = "=RSS|'" & code & ".TJ'!現在値"
End If
End Sub　　※改行は省略
及び同モジュール内に先ほどのChengeイベントを記載

これでB６～300に銘柄番号を入力すると、（C～Eの数値及び）F6～300に各銘柄の現在値が表示されるので、右隣セル（ここでいうG6～300）に１分前の株価が１分間固定で出るよう
Sub 急騰急落告知()
Range("A1").Value = Now
Range("B1").Value = Now + TimeValue("00:01:00")
Range("F6:F300").Copy
Range("G6:G300").PasteSpecial Paste:=xlPasteValues
Application.OnTime Now + TimeValue("00:01:00"), "急騰急落告知", Now + TimeValue("00:02:00")
End Sub
を入力しました。
続いてH列に現在値が、１分前株価の何％騰落したのか表示するために、各セルに
=IFERROR((F6/G6*100)-100,"0")を入力（６行目を例示）
A列に急落ランキングが出るように=RANK(H6,$H$6:$H$300,1)（６行目を例示）を入力
この一覧表のQ列に、一番下落している銘柄の比率を表示
=VLOOKUP(1,$A$6:$H$300,8,FALSE)←最初の数字を2.3と変更し３位までをQ6からQ8までに表示してます。

Q値は、別のセルにおいて証券会社から１秒ごとに取得した値を独自で計算し、ランキング化たものを見やすくするために数式を再入力したものになります。
現在でも、-2以下の数値を入力した直後は音が鳴りますが、あくまで、「１分以内に-2％以下になった銘柄があったら、00秒ごと（１分スパン）で鳴るだけ」なのです。音で急落をすぐに察知せきません。
長々と失礼いたしました。。