Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Автоматический пересчёт функции, Пользовательская функция почему-то не считается автоматом
 
Добрый день!

Никак не могу взять в толк, как сделать так, чтобы функция, выстраданная за целый день, всё же считала сама себя постоянно. Т.е. динамически обновлялась, в зависимости от того, как меняются условия, в неё заложенные.

Дано:

Есть список фамилий, числа и список еды, нужно найти, сколько еды съела фамилия в такое-то число. Предложения по перестройке формата базы, откуда берутся данные, не рассматриваются, поскольку пример в сотню раз упрощает то, что есть на самом деле.

Фамилию и число можно менять - в зависимости от этого ищется количество еды. Всё усложняется именно тем, что фамилии могут идти вперемешку и повторяться на листе тысячу раз.

Поэтому функция простым образом получает адрес ячейки и возвращает значение. Она работает.

Что не работает:

Пример 1. Функция прописана в ячейку как формула. Работает 1 раз и не обновляется. Обновится если нажать Enter дважды, т.е. практически заново прописать формулу. На любые изменения условий ячейка не реагирует.

Пример 2. В код листа запихан вызов функции при событии изменения хоть чего. В итоге функция пересчитывается, если менять одно условие, секунду показывает результат, потом сбивается в ошибку "#ЗНАЧ". Если поменять ещё и второе условие - Эксель выдаёт "Нехватку системных ресурсов", ошибки и вылетает даже иногда.

Вопрос: как сделать, чтобы функция обновлялась? Возможно неправильно прописан возврат значения в ячейку. Возможно вызов.

Помогите!
помогите усовершенствовать код преобразования условного форматирования в обычное
 
В потугах решить проблему преобразования условного форматирования в обычное макросом (не надстройкой - не получится, это обязательное и безоговорочное условие), наткнулся на работающий код:  
 
Sub ConditionalFormatDelink(rRng As Range)  
Dim vConditionsSyntax, rCell As Range, rCFormat As Range, iCondition As Integer  
Dim sFormula As String, vCSyntax, vOperator, iBorder As Integer, vBorders  
Dim firstRow As Long, firstColumn As Long, firstCell As Range, conditionArea As Range  
 
 
vBorders = Array(xlEdgeLeft, xlEdgeRight, xlEdgeTop, xlEdgeBottom)  
 
 
' Syntax for "Value is" Conditions  
vConditionsSyntax = Array( _  
   Array(xlEqual, "CellRef = Condition1"), _  
   Array(xlNotEqual, "CellRef <> Condition1"), _  
   Array(xlLess, "CellRef < Condition1"), _  
   Array(xlLessEqual, "CellRef <= Condition1"), _  
   Array(xlGreater, "CellRef > Condition1"), _  
   Array(xlGreaterEqual, "CellRef >= Condition1"), _  
   Array(xlBetween, "AND(CellRef >= Condition1, CellRef <= Condition2)"), _  
   Array(xlNotBetween, "OR(CellRef < Condition1, CellRef > Condition2)") _  
)  
 
 
' Get cells with format  
On Error GoTo EndSub  
Set rCFormat = rRng.SpecialCells(xlCellTypeAllFormatConditions)  
 
 
On Error Resume Next  
For Each rCell In rCFormat ' Loops through all the cells with conditional formatting  
   If Not IsError(rCell) Then ' skips cells with error  
       rCell.Activate  
       With rCell.FormatConditions  
           For iCondition = 1 To .Count ' loops through all the conditions  
                 
               'Locate the first cell in the AppliesTo area (used as a reference for sFormula)  
               firstRow = .Item(iCondition).AppliesTo.Row  
               firstColumn = .Item(iCondition).AppliesTo.Column  
                 
               If .Item(iCondition).AppliesTo.Areas.Count > 1 Then  
                   For Each conditionArea In .Item(iCondition).AppliesTo.Areas  
                       If conditionArea.Row < firstRow Then firstRow = conditionArea.Row  
                       If conditionArea.Column < firstColumn Then firstColumn = conditionArea.Column  
                   Next conditionArea  
               End If  
 
 
               Set firstCell = Cells(firstRow, firstColumn)  
                 
               sFormula = .Item(iCondition).Formula1  
               Err.Clear  
               vOperator = .Item(iCondition).Operator  
               If Err <> 0 Then ' "Formula Is"  
                   Err.Clear  
               Else ' "Value Is"  
                   For Each vCSyntax In vConditionsSyntax ' checks all the condition types  
                       If .Item(iCondition).Operator = vCSyntax(0) Then  
                           ' build the formula equivalent to the condition  
                           sFormula = Replace(vCSyntax(1), "Condition1", Evaluate(sFormula))  
                           sFormula = Replace(sFormula, "CellRef", rCell.Address)  
                           sFormula = Replace(sFormula, "Condition2", Evaluate(.Item(iCondition).Formula2))  
                           Exit For  
                       End If  
                   Next vCSyntax  
               End If  
                 
               'Shift formula (relate it to the first cell of the AppliesTo area)  
               sFormula = Application.ConvertFormula(Formula:=sFormula, fromReferenceStyle:=xlA1, toReferenceStyle:=xlR1C1, RelativeTo:=firstCell)  
               sFormula = Application.ConvertFormula(Formula:=sFormula, fromReferenceStyle:=xlR1C1, toReferenceStyle:=xlA1, RelativeTo:=rCell)  
                 
               If Evaluate(sFormula) Then  
                   ' The cell has a condition = True. Delink the format from the conditional formatting  
                     
                   ' Background  
                   If Not IsNull(.Item(iCondition).Interior.ColorIndex) Then _  
                       rCell.Interior.Color = .Item(iCondition).Interior.Color  
 
 
                   'Exit on StopIfTrue  
                   If .Item(iCondition).StopIfTrue Then Exit For  
               End If  
           Next iCondition  
       End With  
   End If  
   rCell.FormatConditions.Delete ' deletes the cell's conditional formatting  
Next rCell  
EndSub:  
End Sub  
 
И действительно - код работает!  
Но, он понимает только два условия - условие и отсутствующее условия.  
В документе же, в который требуется вставить этот код - четыре условия:  
 
1. Если значение на 5% больше x - то ячейка зелёная  
2. Если значение на 5% меньше х - то ячейка красная  
3. Если значение меньше х от ДО 5% - то ячейка жёлтая  
4. В других случаях форматирование не задано.  
 
Код работает, но, учитывая лишь два условия - перекрашивает ячейки, попавшие под первое условие - в зелёный, все остальные в красный, вне зависимости от значений, просто потому, что не понимает, что есть ещё пункты 3 и 4.    
 
В итоге на листах, где условное форматирование разное - получается полный рандом. Как расширить код до 4 условий? Автор кода мне не отвечает (код не сворован - он был в открытом доступе на англоязычном форуме).
пакетное копирование цвета условного форматирования
 
Добрый день!  
 
Задался такой идеей:  
 
Дано: есть отчётная таблица, где ячейки выделяются цветом условным форматированием в зависимости от значения. Скажем так - ведётся отчёт, где успех фиксируется зелёным, неуспех красным - в зависимости от отклонения (положительного или отрицательного) от цели.  
 
Проблема: если цели по значению меняются, то меняется ВЕСЬ ряд исторических данных, что делает отчёт некорректным - ведь раньше цели были другие, соответственно, успех/неуспех был другой.  
 
Например: считаем количество спичек в пачке. если оно больше 100 - то зелёный цвет, меньше - красный. и так было целый год, целый год мы вели такой отчёт. НО! сегодня цель изменилась - теперь норма спичек - 150. получается по новым целям-  что раньше мы все цели проваливали, но это же неправильно, так ведь?  
 
Решение: чтобы избежать такого недоразумения, решено "фиксировать" значения и цвет. То бишь вместо условного форматирования делать перманентный цвет. Желательно ещё и значения фиксировать, чтобы замещать ими формулы, где они есть. Всё это нужно сделать лишь с непустыми ячейками на листе. Но если цикл копирования-вставки значений с поиском непустых ячеек на листе сделать не так трудно, то:  
 
Вопрос: как организовать копирование цвета из условного форматирование в ячейке с заменой на перманентный?
Подсчёт ячеек по цвету условного форматирования
 
День добрый, правда замучался искать ответ на вопрос, перепробовал кучу вариантов.  
 
Цель: добиться того, чтобы в ячейке считалось количество ячеек, имеющих заливку определённого цвета в столбце.    
 
Оговорки: цвет заливки определяется условным форматированием на основе значения. Именно это и не даёт реализовать идеи, которые были найдены.  
 
Средства: идеальнее всего было бы формулой или функцией, поскольку документ автономный, надстройки таким образом исключаются, макросы нежелательны, потому что предназначается файл для людей не столь одарённых.  
 
Есть идеи? Возможно ли? Или бросить автоматизацию, даёшь ручной труд?
Макрос для копирования макросов из одной книги в другую, без привязки к первой
 
Добрый день!  
 
Перерыл кучу тем и форумов, так и не нашёл ответа. Нашёл здесь работающий макрос для панели, но он не подошёл под мою ситуацию. Ещё нашёл вариант пользоваться personal.xlsb, тоже, кажется не вариант.  
 
Суть - есть уже почти полностью готовый инструмент на Экселе по созданию новой книги с формулами, оформлением и прочим. Единственное, что осталось - научить этот инструмент переносить в новую книгу часть макросов, которая там нужна.  
 
Макросы я переношу простым кодом  
 
ActiveWorkbook.VBProject.VBComponents("Module1").Export ("c:\Module1.bas")  
Application.VBE.ActiveVBProject.VBComponents.Import ("c:\Module1.bas")  
Kill ("c:\Module1.bas")  
 
Макрос успешно переносится, но!  
 
Графическая кнопка (по сути - форма прямоугольника) на листе имеет привязку к этому макросу. При копировании листа с кнопкой, затем экспорта-импорта модуля, кнопка остаётся привязанной к первому документу. Убрать бы путь (и тут меня можно ткнуть в тему, про убирание пути у панели макросов - но, я ж пишу, к этой кнопке он не работает, к VB кнопке, кстати, тоже).  
 
Personal.xlsb тоже не вариант - поскольку документ должен быть использован на бесчисленном множестве компьютеров. Или научите принудительно импортировать эти модули в личную книгу каждого пользователя.  
 
Как реализовать этот программный перенос макроса?
Страницы: 1
Наверх