プロが教えるわが家の防犯対策術!

以下のマクロはセルA1~A100にて1が表示されると音(Beep)が鳴るというものです。これを下記(1)(2)ができるように修正したいです。ご教示お願いします。
(1)音(Beep)と同時にセルA1~A100のどのセルにて1が表示されたかわかるようにしたいです。メッセージボックスなどにて表示させるにはどのように修正すれば良いですか?
例.A12で1が表示されたら音が鳴りメッセージボックスにA12と表示される。続いてA55で1が表示されたら音が鳴りメッセージボックスにA55と表示される、みたいに・・・。
(2)音がBeepですが、これ以外に音を変更させることは可能ですか?
音は何でもいいです。(ピーとかポロンなど)
※このマクロはシート右クリック→コードの表示で開いた所に打ち込んでいます。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Variant
Dim r As Range
Dim c As Variant
On Error GoTo EndLine
i = Null
Set r = Target.DirectDependents
For Each c In Range("A1:A100").Cells
If Not Intersect(r, c) Is Nothing Then
i = c.Value
Exit For
End If
Next c
Application.EnableEvents = False
If i = 1 Then
Beep
End If
Set r = Nothing
EndLine:
Application.EnableEvents = True

A 回答 (8件)

では、少し仕様を変更してみましょう。


作業列としてD列を使います。
また、数式を変更し、条件付き書式とWorksheet_Calculateイベントを使ってみます。

A1セルの数式を

=AND(B1<>0,B1=C1)

としてください。
A100までコピーします。

A1からC100までを選択して、(A1セルがアクティブな状態)
~~~~~~~~~~
[条件付き書式]の[数式が▼]で[ =$D1 ]。( $ に注意)
[条件付き書式]の[書式]クリックし、[パターン]タブで『赤』塗りつぶし。
[OK]で閉じます。

設定したシートのシートモジュールのWorksheet_Changeイベントは削除し、
以下のコードに差替えます。

Private Sub Worksheet_Calculate()
  Dim r As Range
  
  Set r = Range("A1:A100").Find(What:="TRUE", LookIn:=xlValues)
  If Not r Is Nothing Then
    Application.Calculation = xlCalculationManual
    With r
      Application.Goto .Offset(, 1)
      .Offset(, 3).Value = .Offset(, 2).Value
      .Offset(, 2).ClearContents
    End With
    Application.Calculation = xlCalculationAutomatic
    Set r = Nothing
    MsgBox "warning"
  End If
End Sub

B列とC列の値が一致したら、メッセージボックスを表示させ、
該当セルを選択します。
同時にC列の値をD列にシフトさせ、条件付き書式で色づけします。

リセットしたい場合は、D列の値をクリアし、監視値をC列に入力し直せば良いです。
計算方法が『手動』の場合は動きませんから、必ず『自動』で行って下さい。

数式がB1=C1でいいのか?ですが、応用してみてください。
多分 B1>=C1 などとしたほうが良いのでは?
    • good
    • 0

(#7補足へのレスです)



まず、簡単な例で実験実験^ ^

1)新規シートのシートモジュールに以下コピーペースト。

Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox "Change"
End Sub

2)そのシートのA1セルに 1 と入力。(どこでも構わないンですが)
3)A1セルの 1 をクリアしてみる。
4)A1セルに 1 と入力してみる。
5)A1セルにもう一度 1 と入力してみる。

どうですか?
Worksheet_Changeイベントはセルの値そのものを変更させる時に動くイベントです。

6)同じシートに別シート参照の数式を入れてみる。例えば B1 セルに

=Sheet2!A1

(数式の入力時にはWorksheet_Changeイベントが動きます)

7)次にSheet2のA1に 1 と入れてみる。

どうでしょう?
数式を入れたセルに『表示された値』は変化していますが
Worksheet_Changeイベントは動きません。
セルに『入力された値(つまり数式)』は変化していないからです。

8)同じシートのシートモジュールに今度は以下コピーペースト。

Private Sub Worksheet_Calculate()
MsgBox "Calculate"
End Sub

9)さきほどの参照先Sheet2のA1セルをクリアしてみる。
10)同じくSheet2のA1に 1 と入れてみる。

どうでしょう?
Worksheet_Changeイベントはシートに数式があり、再計算される時に動くイベントです。

kozou1126さんの状況で言うと、
B列RSSの『表示結果』や、A列の判定数式の『表示結果』が変わっただけでは
Worksheet_Changeイベントは動かないという事です。

そのため、Worksheet_Calculateイベントに変更し、
シートが再計算される度に

Range("A1:A100").Find(What:="TRUE", LookIn:=xlValues)

この部分でA列の表示結果を検索して、
TRUE 表示されたセルがあった場合のみ処理を行うように変更してみました。
    • good
    • 0
この回答へのお礼

わかり易く解説していただきありがとうございます。
シートモジュールにも色々あるのですね・・。
今後のマクロの勉強に役立てていきます。
今回は度重なる質問にレスいただきましてありがとうございました。

お礼日時:2007/07/12 23:50

ごめんなさいorz


>多分 B1>=C1 などとしたほうが良いのでは?
の場合、
A列の式は
=AND(B1<>0,C1<>0,B1>=C1)
などと、C1セルが空白の場合の判定も加えておいてください。

数式の設定如何によっては、無限Loopに陥いるかも。
その場合とりあえず[Ctrl]+[Break]キーで抜ける事はできます。

この回答への補足

ありがとうございます。解決しました。
なぜ以前のコードは実行されなかったのですか?
Worksheet_Changeというものがダメだったのですか?
もし差し支えなければ教えてください。
マクロの知識不足ですいません・・・。

補足日時:2007/07/11 22:00
    • good
    • 0

#3補足に対してのレスです。


>この条件下でもpauNedさんのマクロは実行されますか?
とご質問されるという事は、私のコードでは実行されないのですね?
最初にご提示されたコードの方がうまく機能しているなら、
私のはカン違いだったかもしれないので捨てて頂いて結構ですよ。

B列とC列の値を手作業で変更するなら、たぶんどちらも機能するとは思いますが、
私のが動かないなら、
>BとCの値はリアルタイムで変化しています。
というのがWorksheet_Changeイベントでは感知できないからなのでしょう。
そちらのコードが動いているなら、別のイベントコードがあるのではないかと思います。(推測です)
『リアルタイムで変化』というのが具体的にどんな機能によるものなのかが不明なので、
なんとも言えませんが、Worksheet_Changeイベントではお望みのものができないのではないかと思います。
もう少し詳細説明があったら、もしかしたら他の方からもアドバイスがあるかもしれません。
1)ご提示のコードでは機能しているのか。機能している場合、他にイベントコードがないか。
2)どんな機能を使って『リアルタイムで変化』させているのか。
差支えなければ以上2点について教えてください。

この回答への補足

返答遅れてすいません。
セルB列とC列の値を手入力してA列に1が表示された場合、私とpauNedさんのコードでは実行されるのですが、B列又はC列が手入力ではなく、変化してA列に1が表示された場合、私とpauNedさんのコードは実行されません。
B列の値は、楽天証券のRSS(リアルタイムスプレッドシート)というものを使用して株価を取り込んでおり、常時変化しています。C列には任意の値を手入力しており、B列の値が変化してC列の値と同一になるとA列に1が表示されます。なぜかはわかりませんがこの場合、A列に1が表示されても実行されず困っています・・・。

補足日時:2007/07/09 22:06
    • good
    • 0

随分コードが長く、何かの例を修正して、複雑なことをしているようだが、最小限にすると、下記でよいのでは。


ーーー
Sheet1のシートモジュールに
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1:A100")) Is Nothing Then
MsgBox "範囲外"
Exit Sub
Else
MsgBox "範囲内" & Target.Address
If Target = 1 Then
test01
End If
End If
End Sub
(MsgBoxは目障りならコメント化してください。)
On Errorは入れたほうが良いかも。
Application.EnableEvents = False
は必要かな。
ーーー
標準モジュールに
Public Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Sub test01()
Call Beep(262, 300)
Call Beep(294, 300)
Call Beep(330, 300)
Call Beep(349, 300)
Call Beep(392, 300)
Call Beep(440, 300)
Call Beep(494, 300)
Call Beep(523, 300)
End Sub
と入れる。
    • good
    • 0
この回答へのお礼

コードの修正までしていただき、ビックリです。
参考になりました。ありがとうございます。

お礼日時:2007/07/11 21:59

こんにちは。


かん違いでなければ、Loopしなくても良いような気もするのですが、
例えば

Private Sub Worksheet_Change(ByVal Target As Range)
  On Error GoTo EndLine
  With Intersect(Target.DirectDependents, Range("A1:A100"))
    If .Cells(1).Value = 1 Then MsgBox .Cells(1).Address(0, 0)
  End With
EndLine:
End Sub

...こんな感じ?
音量をミュートにしていなければ、MsgBoxが出る時に「一般の警告音」が鳴ると思うのですが、
それでは代用できないという場合はBeep加えてください。

この回答への補足

回答ありがとうございます。pauNedさんが回答していただいたマクロについて質問させてください。
1)A1~100には関数式が入っています。セルBとCの値が同一になったら1と表示されます。BとCの値はリアルタイムで変化しています。この条件下でもpauNedさんのマクロは実行されますか?
2)他のシートを開いて作業している時もメッセージボックスが表示されますか?
1)2)ともに実行されるようにしたいのですが・・・。
よろしくお願いします。

補足日時:2007/07/06 16:24
    • good
    • 0

#1です。


音も変えたいんでしたね。

では、現在のシートのモジュールではなく標準モジュールの一番上に

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

と入れて下さい。

次に、現在のBeepの部分を

Call Beep(262, 200)
Call Beep(294, 200)
Call Beep(330, 200)

に変えてみてください。
    • good
    • 0
この回答へのお礼

ありがとうございました。
知識不足ですいません、参考になりました。

お礼日時:2007/07/11 21:57

現在のBeepの次の行に


MsgBox c.Address
を挿入してください。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!