Запуск функции в режиме реального времени в макросе Excel
Мне нужна идея, чтобы эта функция обновлялась в режиме реального времени. Эта функция считает цвет ячеек для нужной мне работы.
Function COUNTCOLOR(celdaOrigen As Range, rango As Range)
Application.Volatile
Dim celda As Range
For Each celda In rango
If celda.Interior.Color = celdaOrigen.Interior.Color Then
COUNTCOLOR = COUNTCOLOR + 1
End If
Next celda
End Function
Я уже пытаюсь запустить эту функцию
Application.CalculateFullRebuild
Но это не сработало в режиме реального времени, мне пришлось назначить эту функцию кнопке, и когда я хочу обновить ячейки, которые подсчитывают цвета, я нажимаю кнопку, но это не то, что я хочу. Я хочу, чтобы ячейки считали цвета в режиме реального времени, я хочу, чтобы они показывали мне число сразу же, когда я меняю цвет. Ячейка, которая считает цвет, имеет следующую формулу:
=COUNTCOLOR(A1;A1:A9998)
Где «A1» — это ячейка цвета, который мне нужен для подсчета ячеек (например, образец), а «A1: A9998» — это диапазон, в котором я хочу, чтобы формула нашла цвет в предыдущем назначенном образце. Ячейка покажет количество ячеек в диапазоне с цветом образца.
Я надеюсь, что эта информация, которую я предоставил, может помочь вам дать мне хороший ответ :)
Большое спасибо!
Ответы 2
Возможно, это не самое элегантное решение, но оно работает. Идея состоит в том, чтобы запускать Sub каждые 5-10 секунд, чтобы он работал в режиме реального времени.
Вот код:
Sub COUNTCOLOR()
Dim RunTime
Dim COUNTCOLOR As Integer
Dim celda As Range
Dim lastRow As Variant
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
Dim rango As Range
Set rango = Range("A1:A" & lastRow)
For Each celda In rango
'Compare cell interior color with cell A1
If celda.Interior.Color = Cells(1, "A").Interior.Color Then
COUNTCOLOR = COUNTCOLOR + 1
End If
Cells(1, "C").Value = COUNTCOLOR
Next celda
'To run sub every 5 seconds
RunTime = Now + TimeValue("00:00:05")
Application.OnTime RunTime, "COUNTCOLOR"
End Sub
Подход с таймером, вероятно, является лучшим возможным обходным путем. Это решение может быть немного аккуратнее. Volatile не влияет на подпрограммы; RefreshAll не требуется, если нет внешних данных; и COUNTCOLOR должен быть целым числом, чтобы возвращать 0 по умолчанию, если нет ячеек с совпадающим цветом. Отключение ScreenUpdating также не требуется при простом обновлении значения одной ячейки.
Это было очень хорошее решение, но из-за моего требования я думаю, что это невыполнимо, я очень ценю ваши усилия по помощи мне. Мне было интересно, могу ли я добавить в свой исходный код что-то, чтобы он снова запускался (пересчитывал) каждый раз, когда я использую кнопку «Сохранить». Как вы думаете, это возможно? Я думаю, что это может быть хорошим решением для меня тоже! ;)
Затем вы можете использовать событие Workbook_BeforeSave, ниже я опубликую другое решение.
Вставьте модуль класса и назовите его ClsMonitorOnupdate.
Вставьте код ниже
Option Explicit
Private WithEvents objCommandBars As Office.CommandBars
Private rMonitor As Range
Public Property Set Range(ByRef r As Range): Set rMonitor = r: End Property
Public Property Get Range() As Range: Set Range = rMonitor: End Property
Private Sub Class_Initialize()
Set objCommandBars = Application.CommandBars
End Sub
Private Sub Class_Terminate()
Set objCommandBars = Nothing
End Sub
Private Sub objCommandBars_OnUpdate()
If ActiveWorkbook.Name <> ThisWorkbook.Name Then Exit Sub
If TypeName(Selection) <> "Range" Then Exit Sub
If Intersect(Selection, rMonitor) Is Nothing Then Exit Sub
rMonitor.Dirty 'dosomething to trigger your function
End Sub
В разделе ThisWorkbook вы указываете:
Option Explicit
Private Const sRanges As String = "A1:A100" 'adjust to your range Rango?
Private Const sSheet As String = "YourSheetName" 'adjust to your sheetname
Private cMonitor As ClsMonitorOnupdate
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set cMonitor = Nothing
End Sub
Private Sub Workbook_Open()
Set cMonitor = New ClsMonitorOnupdate
Set cMonitor.Range = Sheets(sSheet).Range(sRanges)
End Sub
Настройте свое имя листа и диапазон для мониторинга, после запуска события WorkBookopen ваши диапазоны будут отслеживаться, а изменение цвета будет пересчитывать вашу функцию Countcolor (вы можете оставить application.volatile вне ее)
Нет встроенного «события», которое вызывается изменением цвета ячейки. Вам нужно будет создать свой собственный из очереди сообщений приложения.