详细介绍:vb监测Excel两个单元格变化,达到阈值响铃

需求

Excel中建立监控两个单元格之间的变化范围,当达到某个设定的值的范围内时,完成自动响铃提示。

实现:

  1. 首先设置Excel,开启宏、打开开发者工具,点击visual Basic按钮,然后在左侧双击需要监测的sheet。
  2. 此时会打开一个代码编辑窗口,在窗口中粘贴代码,修改必须监控的单元格,随后保存。
  3. 将响铃用的wav格式文件放入到D盘,以下以D盘为例,可自定义。
  4. 此时回到Excel页面然后在对应的单元格编辑数字进行测试。
  5. 以下代码实现了A1到B10这一组范围的多个单元格对,当有一个有变化达到条件时即可出发响铃。
Private Declare PtrSafe Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" _    (ByVal pszSound As String, ByVal hmod As Long, ByVal fdwSound As Long) As Long ' 常量定义Private Const SND_ASYNC = &H1        ' 异步播放(后台播放)Private Const SND_FILENAME = &H20000 ' 参数是文件名Private Const SND_NODEFAULT = &H2    ' 找不到文件时不播放默认声音 ' 模块级变量,用于记录已触发过的行和对应的值Private triggeredRows As Object Private Sub Worksheet_Activate()    ' 初始化字典,在工作表激活时执行一次    If triggeredRows Is Nothing Then        Set triggeredRows = CreateObject("Scripting.Dictionary")    End IfEnd Sub Private Sub Worksheet_Calculate()    Dim i As Long    Dim threshold As Double    Dim soundFile As String    Dim valA As Variant, valB As Variant    Dim diff As Double    Dim key As String    Dim currentHash As String        ' 设置参数    threshold = 2                   ' 阈值    soundFile = "D:\xm3555.wav"     ' WAV 文件路径     ' 初始化 Dictionary    If triggeredRows Is Nothing Then Set triggeredRows = CreateObject("Scripting.Dictionary")     ' 遍历每一行    For i = 1 To 10        valA = Range("A" & i).Value        valB = Range("B" & i).Value                ' 确保都是数字        If IsNumeric(valA) And IsNumeric(valB) Then            diff = Abs(valA - valB)                        ' 构造唯一标识符(当前 A 和 B 的值组合)            currentHash = valA & "|" & valB                        key = "Row" & i                        ' 如果这一行没有触发过,或者值发生了变化            If Not triggeredRows.Exists(key) Or triggeredRows(key) <> currentHash Then                If diff  "" Then                        PlaySound soundFile, 0, SND_ASYNC Or SND_FILENAME Or SND_NODEFAULT                    Else                        MsgBox "警告音文件未找到: " & soundFile, vbExclamation                        PlaySound vbNullString, 0, SND_ASYNC                    End If                                        ' 更新记录为当前值                    triggeredRows(key) = currentHash                Else                    ' 差值不小于阈值,则清除该行记录(可选)                    If triggeredRows.Exists(key) Then                        triggeredRows.Remove key                    End If                End If            End If        End If    Next iEnd Sub

posted on 2025-07-25 12:07  ljbguanli  阅读(16)  评论(0)    收藏  举报