Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Гистограмма на основе формулы
 
#1
27.10.2020 18:14:22

Здравствуйте. Можно ли, а если можно то как сделать гистограмму, чтобы она работала в ячейке, где расположены цифры с текстом? В качестве текста плюсы и минусы после числа.
 
 
 
#2
28.10.2020 06:03:00
rud.666,
привет, а почему бы не поставить рядом формулу с обрезкой данного текста, и уже с него построить диаграмму?
 
 
 
#3
30.10.2020 20:13:07

Ставить рядом формулу с обрезкой данного текста не совсем удобно

Нашел такой выход: перенос текста в формат ячейки

Скрытый текст
[CODE][/CODE]

Возник вопрос. Чем можно заменить строчку SendKeys "{F2}+{Enter}"? На выполнение этой строчки уходит много времени, а без неё ничего не работает. Строчка cell.Value = cell.Value тоже не помогает.

P.S. Тему, наверное, лучше сменить на "Гистограмма в ячейке с текстом"

Изменено: rud.666 - 30.10.2020 20:20:43
 
 
 
#4
31.10.2020 13:56:50
rud.666, здравствуйте. Проверил Ваши макросы на своем ноутбуке, первый раз все сработало (гистограмма появилась как и положено было по задаче, во всех ячейках), а потом все перестало (на новых листах пробовал тоже - диапазон копируется,  по ячейкам макросом "формат" проход осуществляется, но форматирование не срабатывает.  Я не профи, может разработчики в мою и в Вашу версию Excel что-то поместили, о чем никому неизвестно? :)  Поскольку все Гуру молчат в этой теме, рискну предположить, что источник проблемы в цифровой части Вашего Ника :) Или - как предположение - может правила УФ сначала задавать на том листе и на тот диапазон, в который копируете? Не пробовал. Ускорить отключением обновления экрана не пробовали? У Вас же есть такая строка в макросе который копирует данные на второй лист :)
 
 
 
#5
31.10.2020 14:03:02
При записи через .Value =.Value Excel не пытается определять типы данных, т.к. смены значения не происходит. В таких случаях обычно используют свойство Formula, смена которого всегда вызывает переопределение типов. Поэтому вместо:
Код
For Each cell In celll
    SendKeys "{F2}+{Enter}"
    Next cell
можно записать одну строку:
Код
celll.Formula = celll.Formula
а вот так должно быть в разы быстрее:
Код
Sub формат()
    Dim celll As Range, resPlus As Range, resMinus As Range, rc As Range
    Set celll = Range("A1:E13")
    Application.ScreenUpdating = False
    For Each rc In celll
        If rc.Value Like "*+*" Then
            If resPlus Is Nothing Then
                Set resPlus = rc
            Else
                Set resPlus = Union(rc, resPlus)
            End If
        End If
        If rc.Value Like "*-*" Then
            If resMinus Is Nothing Then
                Set resMinus = rc
            Else
                Set resMinus = Union(rc, resPlus)
            End If
        End If
    Next rc
    If Not resPlus Is Nothing Then
        resPlus.Replace What:="+", Replacement:="", lookat:=xlPart
        resPlus.NumberFormat = "#,##.0 +"
    End If
    If Not resMinus Is Nothing Then
        resMinus.Replace What:="-", Replacement:="", lookat:=xlPart
        resMinus.NumberFormat = "#,##.0 -"
    End If
    celll.Formula = celll.Formula
    Application.ScreenUpdating = True
End Sub
Изменено: Дмитрий(The_Prist) Щербаков - 31.10.2020 14:09:26
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#6
31.10.2020 14:20:29
Дмитрий(The_Prist) Щербаков, в первом случае гистограмма появляется примерно в 30% ячейках. Во втором случае где-то остаются минусы (текст) в значениях ячеек.
 
 
 
#7
31.10.2020 14:38:26
Цитата
rud.666 написал:
в первом случае гистограмма появляется примерно в 30% ячейках
Ну точно ник поменять нужно, иначе не заработает :) Хотя можно еще приложить файл, в котором
Цитата
rud.666 написал:
в первом случае гистограмма появляется примерно в 30% ячейках. Во втором случае где-то остаются минусы (текст) в значениях ячеек.
У Вас в примере в исходном сообщении 4 правила УФ, макросом меняете одно. Остальные три правила не понимают что они должны делать...  Говорю же - не подумали про ник :)
Изменено: _Igor_61 - 31.10.2020 14:45:09
 
 
 
#8
31.10.2020 14:43:31
Вот здесь ошибку допустил:
Set resMinus = Union(rc, resMinus)
Плюс чутка доработал напильником:
Код
Sub формат()
    Dim celll As Range, resPlus As Range, resMinus As Range, rc As Range
    Set celll = Selection 'Range("A1:E13")
    Application.ScreenUpdating = False
    celll.NumberFormat = ""
    For Each rc In celll
        If rc.Value Like "*+*" Then
            If resPlus Is Nothing Then
                Set resPlus = rc
            Else
                Set resPlus = Union(rc, resPlus)
            End If
        End If
        If rc.Value Like "*-*" Then
            If resMinus Is Nothing Then
                Set resMinus = rc
            Else
                Set resMinus = Union(rc, resMinus)
            End If
        End If
    Next rc
    
    celll.FormulaR1C1 = celll.FormulaR1C1
    If Not resPlus Is Nothing Then
        resPlus.Replace What:="+", Replacement:="", lookat:=xlPart
        resPlus.NumberFormat = "#,##.0 +"
    End If
    If Not resMinus Is Nothing Then
        resMinus.Replace What:="-", Replacement:="", lookat:=xlPart
        resMinus.NumberFormat = "#,##.0 -"
    End If
    celll.Replace ",", ".", lookat:=xlPart
    Application.ScreenUpdating = True
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#9
31.10.2020 14:44:49
Цитата
_Igor_61 написал:
источник проблемы в цифровой части Вашего Ника
:D  :D
Там еще For Each с SendKeys "{F2}+{Enter}" странно работает: не во всех случаях до конца диапазона проходит. И еще, как выяснилось SendKeys "{F2}+{Enter}"  нормально работает в For Each, если диапазон выделен (Select)

В файле пример, где гистограмма появляется в 30% случаев.
Изменено: rud.666 - 31.10.2020 15:00:50
 
 
 
#10
31.10.2020 14:55:02
Дмитрий(The_Prist) Щербаков, теперь все работает спасибо!
 
 
 
#11
31.10.2020 15:16:33
rud.666, ну вот, не зря же Вам задавали наводящие вопросы :) Получилось :) Но о нике подумайте, нехороший он какой-то :)
 
 
 
Страницы: 1
Наверх