Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Оптимизация кода по графикам - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 2
  • 1
  • 2
  • »
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Оптимизация кода по графикам (Макросы/Sub)
Оптимизация кода по графикам
Gopronotmore Дата: Пятница, 01.02.2019, 21:58 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 120
Репутация: 1 ±
Замечаний: 0% ±

Excel 2007
Добрый вечер, форумчане,

столкнулся с такой проблемой. Есть выпадающий список со значениями от 0 до 40 и рядом самодельный график по значениям в ячейке B.

Подскажите если у меня в планах сделать 10 выпадающих списков и 10 графиков, как грамотно оптимизировать код что бы каждый раз не прописывать новые значения переменных?

Это вообще реально?
К сообщению приложен файл: 7608041.xltm(18.0 Kb)
 
Ответить
СообщениеДобрый вечер, форумчане,

столкнулся с такой проблемой. Есть выпадающий список со значениями от 0 до 40 и рядом самодельный график по значениям в ячейке B.

Подскажите если у меня в планах сделать 10 выпадающих списков и 10 графиков, как грамотно оптимизировать код что бы каждый раз не прописывать новые значения переменных?

Это вообще реально?

Автор - Gopronotmore
Дата добавления - 01.02.2019 в 21:58
Roman777 Дата: Пятница, 01.02.2019, 23:47 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 960
Репутация: 123 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Gopronotmore, например так:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim o(), subO() As Shape
Dim n As Long, i&, j&, k&
Dim flg As Integer
n = 3 ' количесство кружков
ReDim o(1 To n)
ReDim subO(1 To 4)  ' 4 части кружка
    For i = 1 To n
        For j = 1 To UBound(subO)
            k = k + 1
            Set subO(j) = ActiveSheet.Shapes("_o" & k)
        Next j
        o(i) = subO
    Next i
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = 0 Then
        intCorol = vbWhite
    End If
    For i = 1 To UBound(o(Target.Row))
        flg = -1 * (i * 10 <= Target.Value)
        o(Target.Row)(i).Fill.ForeColor.RGB = RGB(112 * flg + 255 * (1 - flg), 244 * flg + 255 * (1 - flg), 125 * flg + 255 * (1 - flg))
    Next i
End Sub
[/vba]
Но вообще первую часть инициализации:

если файл не редактируется (не меняется кол-во кружков), можно было бы засунуть в событие открытия книги... чтобы не каждый раз по новой ссылки назначать.


Много чего не знаю!!!!
 
Ответить
СообщениеGopronotmore, например так:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim o(), subO() As Shape
Dim n As Long, i&, j&, k&
Dim flg As Integer
n = 3 ' количесство кружков
ReDim o(1 To n)
ReDim subO(1 To 4)  ' 4 части кружка
    For i = 1 To n
        For j = 1 To UBound(subO)
            k = k + 1
            Set subO(j) = ActiveSheet.Shapes("_o" & k)
        Next j
        o(i) = subO
    Next i
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = 0 Then
        intCorol = vbWhite
    End If
    For i = 1 To UBound(o(Target.Row))
        flg = -1 * (i * 10 <= Target.Value)
        o(Target.Row)(i).Fill.ForeColor.RGB = RGB(112 * flg + 255 * (1 - flg), 244 * flg + 255 * (1 - flg), 125 * flg + 255 * (1 - flg))
    Next i
End Sub
[/vba]
Но вообще первую часть инициализации:

если файл не редактируется (не меняется кол-во кружков), можно было бы засунуть в событие открытия книги... чтобы не каждый раз по новой ссылки назначать.

Автор - Roman777
Дата добавления - 01.02.2019 в 23:47
Gopronotmore Дата: Суббота, 02.02.2019, 09:48 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 120
Репутация: 1 ±
Замечаний: 0% ±

Excel 2007
Roman777,

Спасибо большое! Это реально круто!
Кружки будут меняться в количестве, по этому в принципе одну вводную и названия изменить не проблема.

Подскажите, а если в выпадающем списке будет текст, например Не выполнено;Выполнено 25%;Выполнено 50%;Выполнено 75%;Выполнено 100%;

я так понимаю что в этом цикле нужно будет менять вводные. Просто я попробовал изменить названия в выпадающем списке и круг сразу покрасился в зеленый
[vba]
Код

    For i = 1 To UBound(o(Target.Row))
        flg = -1 * (i * 10 <= Target.Value)
        o(Target.Row)(i).Fill.ForeColor.RGB = RGB(112 * flg + 255 * (1 - flg), 244 * flg + 255 * (1 - flg), 125 * flg + 255 * (1 - flg))
    Next i
[/vba]

Я так полагаю что тип переменный flg перейдет в Sting, шаг флага сменил на 25, но вот как Выполнено и % туда поставить не получается разобраться в виду своего дилетантства.

[vba]
Код


flg = -1 * (i * 25 & "%" <= Target.Value)

[/vba]

Не работает

Можете подсказать как это сделать? А еще бы был очень признателен, если бы Вы подсказали, в Вашем коде где идет ссылка на ячейки, из которых выбирать данные. Например: если я перемещу столбец А:А в столбец D:D код будет работать, и мне непонятно как код ссылается и определяет откуда берутся данные.
К сообщению приложен файл: 76080412.xlsm(17.4 Kb)


Сообщение отредактировал Gopronotmore - Суббота, 02.02.2019, 09:57
 
Ответить
СообщениеRoman777,

Спасибо большое! Это реально круто!
Кружки будут меняться в количестве, по этому в принципе одну вводную и названия изменить не проблема.

Подскажите, а если в выпадающем списке будет текст, например Не выполнено;Выполнено 25%;Выполнено 50%;Выполнено 75%;Выполнено 100%;

я так понимаю что в этом цикле нужно будет менять вводные. Просто я попробовал изменить названия в выпадающем списке и круг сразу покрасился в зеленый
[vba]
Код

    For i = 1 To UBound(o(Target.Row))
        flg = -1 * (i * 10 <= Target.Value)
        o(Target.Row)(i).Fill.ForeColor.RGB = RGB(112 * flg + 255 * (1 - flg), 244 * flg + 255 * (1 - flg), 125 * flg + 255 * (1 - flg))
    Next i
[/vba]

Я так полагаю что тип переменный flg перейдет в Sting, шаг флага сменил на 25, но вот как Выполнено и % туда поставить не получается разобраться в виду своего дилетантства.

[vba]
Код


flg = -1 * (i * 25 & "%" <= Target.Value)

[/vba]

Не работает

Можете подсказать как это сделать? А еще бы был очень признателен, если бы Вы подсказали, в Вашем коде где идет ссылка на ячейки, из которых выбирать данные. Например: если я перемещу столбец А:А в столбец D:D код будет работать, и мне непонятно как код ссылается и определяет откуда берутся данные.

Автор - Gopronotmore
Дата добавления - 02.02.2019 в 09:48
Roman777 Дата: Суббота, 02.02.2019, 12:11 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 960
Репутация: 123 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Gopronotmore, Добрый день! Текстовые переменные немного иначе сравниваются на "<=". Поэтому приведённый Вами пример не подходит.
Я макрос написал с учётом представленного Вами файла.
Если будете использовать текстовые составляющие, удобно было бы создать словарь и переписать вот так, чтобы сильно код не менять:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim o(), subO() As Shape
Dim n As Long, i&, j&, k&
Dim flg As Integer
Dim oDic as Object
'Создание словаря, где определяются значения (соответствия текста-значению):
Set oDic = CreateObject("Scripting.Dictionary")
oDic.Add "Не выполнено", 0
oDic.Add "Выполнено 25%", 1
oDic.Add "Выполнено 50%", 2
oDic.Add "Выполнено 75%", 3
oDic.Add "Выполнено 100%", 4

n = 3 ' количество кружков
ReDim o(1 To n)
ReDim subO(1 To 4)  ' 4 части кружка
    For i = 1 To n
        For j = 1 To UBound(subO)
            k = k + 1
            Set subO(j) = ActiveSheet.Shapes("_o" & k)
        Next j
        o(i) = subO
    Next i
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = 0 Then
        intCorol = vbWhite
    End If
    For i = 1 To UBound(o(Target.Row))
        flg = -1 * (i  <= oDic(Target.Text))
        o(Target.Row)(i).Fill.ForeColor.RGB = RGB(112 * flg + 255 * (1 - flg), 244 * flg + 255 * (1 - flg), 125 * flg + 255 * (1 - flg))
    Next i
End Sub
[/vba]
На самом деле, если бы было больше частей у кружков и надписи Ваши были однотипными, удобнее и заполнение словаря сделать циклом.
И для задания цвета по выражению [vba]
Код
RGB(112 * flg + 255 * (1 - flg), 244 * flg + 255 * (1 - flg), 125 * flg + 255 * (1 - flg))
[/vba]
переменная flg должна иметь численный тип.


Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Суббота, 02.02.2019, 12:13
 
Ответить
СообщениеGopronotmore, Добрый день! Текстовые переменные немного иначе сравниваются на "<=". Поэтому приведённый Вами пример не подходит.
Я макрос написал с учётом представленного Вами файла.
Если будете использовать текстовые составляющие, удобно было бы создать словарь и переписать вот так, чтобы сильно код не менять:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim o(), subO() As Shape
Dim n As Long, i&, j&, k&
Dim flg As Integer
Dim oDic as Object
'Создание словаря, где определяются значения (соответствия текста-значению):
Set oDic = CreateObject("Scripting.Dictionary")
oDic.Add "Не выполнено", 0
oDic.Add "Выполнено 25%", 1
oDic.Add "Выполнено 50%", 2
oDic.Add "Выполнено 75%", 3
oDic.Add "Выполнено 100%", 4

n = 3 ' количество кружков
ReDim o(1 To n)
ReDim subO(1 To 4)  ' 4 части кружка
    For i = 1 To n
        For j = 1 To UBound(subO)
            k = k + 1
            Set subO(j) = ActiveSheet.Shapes("_o" & k)
        Next j
        o(i) = subO
    Next i
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = 0 Then
        intCorol = vbWhite
    End If
    For i = 1 To UBound(o(Target.Row))
        flg = -1 * (i  <= oDic(Target.Text))
        o(Target.Row)(i).Fill.ForeColor.RGB = RGB(112 * flg + 255 * (1 - flg), 244 * flg + 255 * (1 - flg), 125 * flg + 255 * (1 - flg))
    Next i
End Sub
[/vba]
На самом деле, если бы было больше частей у кружков и надписи Ваши были однотипными, удобнее и заполнение словаря сделать циклом.
И для задания цвета по выражению [vba]
Код
RGB(112 * flg + 255 * (1 - flg), 244 * flg + 255 * (1 - flg), 125 * flg + 255 * (1 - flg))
[/vba]
переменная flg должна иметь численный тип.

Автор - Roman777
Дата добавления - 02.02.2019 в 12:11
Gopronotmore Дата: Суббота, 02.02.2019, 12:39 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 120
Репутация: 1 ±
Замечаний: 0% ±

Excel 2007
Roman777,

это гениально, вот что значит мой дилетантский уровень не дает мне понять, что можно было просто добавить значения!!!

Спасибо Вам большое, очень помогли и + к карме!

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

Но тут столкнулся с тем, что просто не смог доделать. Значение флага изменил как надо, а надпись не добавил, но Вы дали очень оригинальный способ избежать этого в будущем, сделав объектный словарь по значениям.

У меня конечно была идея сделать через условное форматирование, а значения оставить, но это уже больше от безысходности.

А если будет больше кружков, я примерно понимаю о чем вы говорите, но я бы не смог это сделать.

Я если честно не понимаю как эта строка вообще работает

[vba]
Код
RGB(112 * flg + 255 * (1 - flg), 244 * flg + 255 * (1 - flg), 125 * flg + 255 * (1 - flg))
[/vba]

по идее должен был просто быть цвет RGB палитры.

У меня пока простейшее понимание VBA. Я не программист =) по этому циклы для меня и массивы темный лес.
 
Ответить
СообщениеRoman777,

это гениально, вот что значит мой дилетантский уровень не дает мне понять, что можно было просто добавить значения!!!

Спасибо Вам большое, очень помогли и + к карме!

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

Но тут столкнулся с тем, что просто не смог доделать. Значение флага изменил как надо, а надпись не добавил, но Вы дали очень оригинальный способ избежать этого в будущем, сделав объектный словарь по значениям.

У меня конечно была идея сделать через условное форматирование, а значения оставить, но это уже больше от безысходности.

А если будет больше кружков, я примерно понимаю о чем вы говорите, но я бы не смог это сделать.

Я если честно не понимаю как эта строка вообще работает

[vba]
Код
RGB(112 * flg + 255 * (1 - flg), 244 * flg + 255 * (1 - flg), 125 * flg + 255 * (1 - flg))
[/vba]

по идее должен был просто быть цвет RGB палитры.

У меня пока простейшее понимание VBA. Я не программист =) по этому циклы для меня и массивы темный лес.

Автор - Gopronotmore
Дата добавления - 02.02.2019 в 12:39
Roman777 Дата: Суббота, 02.02.2019, 14:04 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 960
Репутация: 123 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
RGB(112 * flg + 255 * (1 - flg), 244 * flg + 255 * (1 - flg), 125 * flg + 255 * (1 - flg))


это необходимо рассматривать вкупе с этим:
[vba]
Код
flg = -1 * (i  <= oDic(Target.Text))
[/vba]
По сути flg - значение целочисленное, а
[vba]
Код
(i  <= oDic(Target.Text))
[/vba]
значение булевое.
Зная, что в VBA булевый true = -1 (целочисленному) и булевый false = 0 (целочисленному),
макрос, в зависимости от условия (i  <= oDic(Target.Text)) записывает в flg 0 и 1 (делая неявное преобразование типов).
Ну а уже в случае, когда у нас 0 в выражении
[vba]
Код
112 * flg + 255 * (1 - flg)
[/vba]
отвалится левая часть (останется 255),
а в случае flg = 1
отвалится правая часть, тогда значение для красного цвета станет 112.
Собственно и получается либо
RGB(255,255,255) - RGB белого цвета
либо
RGB(112,244,125) - RGB Ваш салатовый цвет =)
[p.s.]
Цитата
У меня пока простейшее понимание VBA. Я не программист =) по этому циклы для меня и массивы темный лес.

у меня так же было лет 5 назад. А этот ресурс (и многие, в особенности, отзывчивые люди тут, дали очень-очень хороший старт, что в итоге повлияло даже на смену профессии =)[/p.s.]


Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Суббота, 02.02.2019, 14:16
 
Ответить
Сообщение
RGB(112 * flg + 255 * (1 - flg), 244 * flg + 255 * (1 - flg), 125 * flg + 255 * (1 - flg))


это необходимо рассматривать вкупе с этим:
[vba]
Код
flg = -1 * (i  <= oDic(Target.Text))
[/vba]
По сути flg - значение целочисленное, а
[vba]
Код
(i  <= oDic(Target.Text))
[/vba]
значение булевое.
Зная, что в VBA булевый true = -1 (целочисленному) и булевый false = 0 (целочисленному),
макрос, в зависимости от условия (i  <= oDic(Target.Text)) записывает в flg 0 и 1 (делая неявное преобразование типов).
Ну а уже в случае, когда у нас 0 в выражении
[vba]
Код
112 * flg + 255 * (1 - flg)
[/vba]
отвалится левая часть (останется 255),
а в случае flg = 1
отвалится правая часть, тогда значение для красного цвета станет 112.
Собственно и получается либо
RGB(255,255,255) - RGB белого цвета
либо
RGB(112,244,125) - RGB Ваш салатовый цвет =)
[p.s.]
Цитата
У меня пока простейшее понимание VBA. Я не программист =) по этому циклы для меня и массивы темный лес.

у меня так же было лет 5 назад. А этот ресурс (и многие, в особенности, отзывчивые люди тут, дали очень-очень хороший старт, что в итоге повлияло даже на смену профессии =)[/p.s.]

Автор - Roman777
Дата добавления - 02.02.2019 в 14:04
Gopronotmore Дата: Суббота, 02.02.2019, 15:54 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 120
Репутация: 1 ±
Замечаний: 0% ±

Excel 2007
Roman777,

Большое спасибо за разъяснение, буду тоже пытаться выучить VBA язык!!!

Обычно обучение приходит когда сталкиваешься с проблемой, тогда и происходит необходимость что-то сделать!

Спасибо еще раз за код и за разъяснение....!!!
 
Ответить
СообщениеRoman777,

Большое спасибо за разъяснение, буду тоже пытаться выучить VBA язык!!!

Обычно обучение приходит когда сталкиваешься с проблемой, тогда и происходит необходимость что-то сделать!

Спасибо еще раз за код и за разъяснение....!!!

Автор - Gopronotmore
Дата добавления - 02.02.2019 в 15:54
Gopronotmore Дата: Понедельник, 04.02.2019, 11:49 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 120
Репутация: 1 ±
Замечаний: 0% ±

Excel 2007
Roman777, блин теперь с другой проблемой столкнулся,

при добавлении строки у меня весь код едет.

[vba]
Код


o(Target.Row)(i).Fill.ForeColor.RGB = RGB(112 * flg + 255 * (1 - flg), 244 * flg + 255 * (1 - flg), 125 * flg + 255 * (1 - flg))

[/vba]

Как сделать четкую конкретную привязку для o(Target.Row) например к строке A2???

Подскажите пожалуйста, пытался написать так o(Target.Row - 1), но последний круг не работает из-за этого
К сообщению приложен файл: 4150694.xlsm(20.4 Kb)


Сообщение отредактировал Gopronotmore - Понедельник, 04.02.2019, 12:29
 
Ответить
СообщениеRoman777, блин теперь с другой проблемой столкнулся,

при добавлении строки у меня весь код едет.

[vba]
Код


o(Target.Row)(i).Fill.ForeColor.RGB = RGB(112 * flg + 255 * (1 - flg), 244 * flg + 255 * (1 - flg), 125 * flg + 255 * (1 - flg))

[/vba]

Как сделать четкую конкретную привязку для o(Target.Row) например к строке A2???

Подскажите пожалуйста, пытался написать так o(Target.Row - 1), но последний круг не работает из-за этого

Автор - Gopronotmore
Дата добавления - 04.02.2019 в 11:49
Roman777 Дата: Понедельник, 04.02.2019, 13:26 | Сообщение № 9
Группа: Проверенные
Ранг: Ветеран
Сообщений: 960
Репутация: 123 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Gopronotmore, Пошагово пробегайте используя F8 в окне VBA, так будет легче понять, что куда нужно дописать.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim o(), subO() As Shape
Dim n As Long, i&, j&, k&
Dim flg As Integer
Dim oDic As Object
'Создание словаря, где определяются значения (соответствия текста-значению):
Set oDic = CreateObject("Scripting.Dictionary")
oDic.Add "Не выполнено", 0
oDic.Add "Выполнено 25%", 1
oDic.Add "Выполнено 50%", 2
oDic.Add "Выполнено 75%", 3
oDic.Add "Выполнено 100%", 4

n = 5 ' количество кружков
i0 = 2 'начинаем со второй строки
ReDim o(1 To n)
ReDim subO(1 To 4)  ' 4 части кружка
    For i = 1 To n
        For j = 1 To UBound(subO)
            k = k + 1
            Set subO(j) = ActiveSheet.Shapes("_o" & k)
        Next j
        o(i) = subO
    Next i
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = 0 Then
        intCorol = vbWhite
    End If
    For i = 1 To UBound(o(Target.Row - i0 + 1))
        flg = -1 * (i <= oDic(Target.Text))
        o(Target.Row - i0 + 1)(i).Fill.ForeColor.RGB = RGB(112 * flg + 255 * (1 - flg), 244 * flg + 255 * (1 - flg), 125 * flg + 255 * (1 - flg))
    Next i
End Sub
[/vba]


Много чего не знаю!!!!
 
Ответить
СообщениеGopronotmore, Пошагово пробегайте используя F8 в окне VBA, так будет легче понять, что куда нужно дописать.
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim o(), subO() As Shape
Dim n As Long, i&, j&, k&
Dim flg As Integer
Dim oDic As Object
'Создание словаря, где определяются значения (соответствия текста-значению):
Set oDic = CreateObject("Scripting.Dictionary")
oDic.Add "Не выполнено", 0
oDic.Add "Выполнено 25%", 1
oDic.Add "Выполнено 50%", 2
oDic.Add "Выполнено 75%", 3
oDic.Add "Выполнено 100%", 4

n = 5 ' количество кружков
i0 = 2 'начинаем со второй строки
ReDim o(1 To n)
ReDim subO(1 To 4)  ' 4 части кружка
    For i = 1 To n
        For j = 1 To UBound(subO)
            k = k + 1
            Set subO(j) = ActiveSheet.Shapes("_o" & k)
        Next j
        o(i) = subO
    Next i
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = 0 Then
        intCorol = vbWhite
    End If
    For i = 1 To UBound(o(Target.Row - i0 + 1))
        flg = -1 * (i <= oDic(Target.Text))
        o(Target.Row - i0 + 1)(i).Fill.ForeColor.RGB = RGB(112 * flg + 255 * (1 - flg), 244 * flg + 255 * (1 - flg), 125 * flg + 255 * (1 - flg))
    Next i
End Sub
[/vba]

Автор - Roman777
Дата добавления - 04.02.2019 в 13:26
Gopronotmore Дата: Понедельник, 04.02.2019, 14:32 | Сообщение № 10
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 120
Репутация: 1 ±
Замечаний: 0% ±

Excel 2007
Roman777, я примерно догадывался что через переменную, но вот одно мне не дает покоя,

Target.Row - i0 + 1

Target.Row по дефолту равен чему? i0 = 2 как прочитать то это? Почему начинается со 2 строки?
 
Ответить
СообщениеRoman777, я примерно догадывался что через переменную, но вот одно мне не дает покоя,

Target.Row - i0 + 1

Target.Row по дефолту равен чему? i0 = 2 как прочитать то это? Почему начинается со 2 строки?

Автор - Gopronotmore
Дата добавления - 04.02.2019 в 14:32
Roman777 Дата: Понедельник, 04.02.2019, 14:38 | Сообщение № 11
Группа: Проверенные
Ранг: Ветеран
Сообщений: 960
Репутация: 123 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Gopronotmore,
Вы же файл прислали, Ваши графические элементы начинаются со 2-й строки.
Target.Row равен строке текущей ячейки. Если изменяете в данный момент A2, то будет равен численно 2.


Много чего не знаю!!!!
 
Ответить
СообщениеGopronotmore,
Вы же файл прислали, Ваши графические элементы начинаются со 2-й строки.
Target.Row равен строке текущей ячейки. Если изменяете в данный момент A2, то будет равен численно 2.

Автор - Roman777
Дата добавления - 04.02.2019 в 14:38
Gopronotmore Дата: Понедельник, 04.02.2019, 14:41 | Сообщение № 12
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 120
Репутация: 1 ±
Замечаний: 0% ±

Excel 2007
Roman777, просто я немного туплю, по идее i0 = 2, а тут еще +1 и значение Target.Row
 
Ответить
СообщениеRoman777, просто я немного туплю, по идее i0 = 2, а тут еще +1 и значение Target.Row

Автор - Gopronotmore
Дата добавления - 04.02.2019 в 14:41
Gopronotmore Дата: Понедельник, 04.02.2019, 14:41 | Сообщение № 13
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 120
Репутация: 1 ±
Замечаний: 0% ±

Excel 2007
Roman777, ну как я понимаю это значение строки, откуда начинается отсчет. Должно быть с i0 = 2, но там +1 значение + еще значение с Target.Row


Сообщение отредактировал Gopronotmore - Понедельник, 04.02.2019, 14:44
 
Ответить
СообщениеRoman777, ну как я понимаю это значение строки, откуда начинается отсчет. Должно быть с i0 = 2, но там +1 значение + еще значение с Target.Row

Автор - Gopronotmore
Дата добавления - 04.02.2019 в 14:41
Roman777 Дата: Понедельник, 04.02.2019, 14:47 | Сообщение № 14
Группа: Проверенные
Ранг: Ветеран
Сообщений: 960
Репутация: 123 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Внимательно смотрите:
[vba]
Код
Target.Row - i0 + 1
[/vba]
для 2й строки:
2-2+1=1


Много чего не знаю!!!!
 
Ответить
СообщениеВнимательно смотрите:
[vba]
Код
Target.Row - i0 + 1
[/vba]
для 2й строки:
2-2+1=1

Автор - Roman777
Дата добавления - 04.02.2019 в 14:47
Gopronotmore Дата: Понедельник, 04.02.2019, 15:01 | Сообщение № 15
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 120
Репутация: 1 ±
Замечаний: 0% ±

Excel 2007
Roman777, ну так получается с 1 строки же должно начинаться, а начинается со 2. Пытаюсь понять логику расчета ))). Получается 1 а начинается со 2 строки а по идее должно быть 2, что бы со 2 строки начинался расчет, или я что-то не так понимаю?
 
Ответить
СообщениеRoman777, ну так получается с 1 строки же должно начинаться, а начинается со 2. Пытаюсь понять логику расчета ))). Получается 1 а начинается со 2 строки а по идее должно быть 2, что бы со 2 строки начинался расчет, или я что-то не так понимаю?

Автор - Gopronotmore
Дата добавления - 04.02.2019 в 15:01
Roman777 Дата: Понедельник, 04.02.2019, 15:42 | Сообщение № 16
Группа: Проверенные
Ранг: Ветеран
Сообщений: 960
Репутация: 123 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
[vba]
Код
o(Target.Row - i0 + 1)(i)
[/vba]
Массив маcсивов "o" представляет собой массив, каждый элемент которого состоит из массива, элементами которого уже являются ссылки на объекты shape.
У Вас 1 кружок - это 4 элемента. Вот и выходит массив кружков. Каждый элемент такого массива является в свою очередь массивом (в данном случае четвертинок).
[vba]
Код
Target.Row - i0 + 1
[/vba]
обращается к некоторому элементу массива o (коим является кружок (который в свою очередь имеет 4 четверти)). У Вас, когда Вы начинаете со второй строки, напротив стоит первый элемент массива кружков.
Вот и получается, для 2й строки мы обращается в первый элемент массива кружков - к первому кружку, а уже "i" определяет к какой секции кружка.


Много чего не знаю!!!!
 
Ответить
Сообщение[vba]
Код
o(Target.Row - i0 + 1)(i)
[/vba]
Массив маcсивов "o" представляет собой массив, каждый элемент которого состоит из массива, элементами которого уже являются ссылки на объекты shape.
У Вас 1 кружок - это 4 элемента. Вот и выходит массив кружков. Каждый элемент такого массива является в свою очередь массивом (в данном случае четвертинок).
[vba]
Код
Target.Row - i0 + 1
[/vba]
обращается к некоторому элементу массива o (коим является кружок (который в свою очередь имеет 4 четверти)). У Вас, когда Вы начинаете со второй строки, напротив стоит первый элемент массива кружков.
Вот и получается, для 2й строки мы обращается в первый элемент массива кружков - к первому кружку, а уже "i" определяет к какой секции кружка.

Автор - Roman777
Дата добавления - 04.02.2019 в 15:42
Gopronotmore Дата: Понедельник, 04.02.2019, 19:27 | Сообщение № 17
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 120
Репутация: 1 ±
Замечаний: 0% ±

Excel 2007
Блин спасибо Вам огромное за разъяснение, теперь стало ясно откуда что берется.

[vba]
Код

Private Sub Worksheet_Change(ByVal Target As Range)
Dim o(), subO() As Shape
Dim n As Long, i&, j&, k&
Dim flg As Integer
Dim oDic As Object
'Создание словаря, где определяются значения (соответствия текста-значению):
Set oDic = CreateObject("Scripting.Dictionary")
oDic.Add "Не начато", -1
oDic.Add "Не выполнено", 0
oDic.Add "Выполнено 25%", 1
oDic.Add "Выполнено 50%", 2
oDic.Add "Выполнено 75%", 3
oDic.Add "Выполнено 100%", 4

n = 5 ' количество кружков
i0 = 2
ReDim o(1 To n)
ReDim subO(1 To 4)  ' 4 части кружка
    For i = 1 To n
        For j = 1 To UBound(subO)
            k = k + 1
            Set subO(j) = ActiveSheet.Shapes("_o" & k)
        Next j
        o(i) = subO
    Next i
    
    If i = -1 Then
        o(Target.Row)(i).Fill.ForeColor.RGB = vbRed
    Else
    For i = 1 To UBound(o(Target.Row - i0 + 1))
        flg = -1 * (i <= oDic(Target.Text))
        o(Target.Row - i0 + 1)(i).Fill.ForeColor.RGB = RGB(112 * flg + 255 * (1 - flg), 244 * flg + 255 * (1 - flg), 125 * flg + 255 * (1 - flg))
    Next i
    End If
End Sub

[/vba]

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


Сообщение отредактировал Gopronotmore - Понедельник, 04.02.2019, 19:30
 
Ответить
СообщениеБлин спасибо Вам огромное за разъяснение, теперь стало ясно откуда что берется.

[vba]
Код

Private Sub Worksheet_Change(ByVal Target As Range)
Dim o(), subO() As Shape
Dim n As Long, i&, j&, k&
Dim flg As Integer
Dim oDic As Object
'Создание словаря, где определяются значения (соответствия текста-значению):
Set oDic = CreateObject("Scripting.Dictionary")
oDic.Add "Не начато", -1
oDic.Add "Не выполнено", 0
oDic.Add "Выполнено 25%", 1
oDic.Add "Выполнено 50%", 2
oDic.Add "Выполнено 75%", 3
oDic.Add "Выполнено 100%", 4

n = 5 ' количество кружков
i0 = 2
ReDim o(1 To n)
ReDim subO(1 To 4)  ' 4 части кружка
    For i = 1 To n
        For j = 1 To UBound(subO)
            k = k + 1
            Set subO(j) = ActiveSheet.Shapes("_o" & k)
        Next j
        o(i) = subO
    Next i
    
    If i = -1 Then
        o(Target.Row)(i).Fill.ForeColor.RGB = vbRed
    Else
    For i = 1 To UBound(o(Target.Row - i0 + 1))
        flg = -1 * (i <= oDic(Target.Text))
        o(Target.Row - i0 + 1)(i).Fill.ForeColor.RGB = RGB(112 * flg + 255 * (1 - flg), 244 * flg + 255 * (1 - flg), 125 * flg + 255 * (1 - flg))
    Next i
    End If
End Sub

[/vba]

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

Автор - Gopronotmore
Дата добавления - 04.02.2019 в 19:27
Roman777 Дата: Понедельник, 04.02.2019, 22:28 | Сообщение № 18
Группа: Проверенные
Ранг: Ветеран
Сообщений: 960
Репутация: 123 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Почему кружки не красятся в красный цвет, если условие было выполнено???

Вместо
[vba]
Код
    If i = -1 Then
        o(Target.Row)(i).Fill.ForeColor.RGB = vbRed
    Else
[/vba]
[vba]
Код
    If Target= -1 Then
        o(Target.Row - i0 + 1)(i).Fill.ForeColor.RGB = vbRed
    Else
[/vba]


Много чего не знаю!!!!
 
Ответить
Сообщение
Почему кружки не красятся в красный цвет, если условие было выполнено???

Вместо
[vba]
Код
    If i = -1 Then
        o(Target.Row)(i).Fill.ForeColor.RGB = vbRed
    Else
[/vba]
[vba]
Код
    If Target= -1 Then
        o(Target.Row - i0 + 1)(i).Fill.ForeColor.RGB = vbRed
    Else
[/vba]

Автор - Roman777
Дата добавления - 04.02.2019 в 22:28
Gopronotmore Дата: Понедельник, 04.02.2019, 23:49 | Сообщение № 19
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 120
Репутация: 1 ±
Замечаний: 0% ±

Excel 2007
Roman777,

Не красит, не работает правило, полагаю что данное правило работало для цикла, а тут получается что цикл после исполняется при невыполнении условия.
К сообщению приложен файл: test.xlsm(20.7 Kb)
 
Ответить
СообщениеRoman777,

Не красит, не работает правило, полагаю что данное правило работало для цикла, а тут получается что цикл после исполняется при невыполнении условия.

Автор - Gopronotmore
Дата добавления - 04.02.2019 в 23:49
Roman777 Дата: Вторник, 05.02.2019, 07:45 | Сообщение № 20
Группа: Проверенные
Ранг: Ветеран
Сообщений: 960
Репутация: 123 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Gopronotmore,
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim o(), subO() As Shape
Dim n As Long, i&, j&, k&
Dim flg As Integer
Dim oDic As Object
'Создание словаря, где определяются значения (соответствия текста-значению):
Set oDic = CreateObject("Scripting.Dictionary")
oDic.Add "Отсутствует", -1
oDic.Add "Не выполнено", 0
oDic.Add "Выполнено 25%", 1
oDic.Add "Выполнено 50%", 2
oDic.Add "Выполнено 75%", 3
oDic.Add "Выполнено 100%", 4

n = 5 ' количество кружков
i0 = 2
ReDim o(1 To n)
ReDim subO(1 To 4)  ' 4 части кружка
    For i = 1 To n
        For j = 1 To UBound(subO)
            k = k + 1
            Set subO(j) = ActiveSheet.Shapes("_o" & k)
        Next j
        o(i) = subO
    Next i
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = 0 Then
        intCorol = vbWhite
    End If
    For i = 1 To UBound(o(Target.Row - i0 + 1))
        If oDic(Target.Text) = -1 Then
            o(Target.Row - i0 + 1)(i).Fill.ForeColor.RGB = vbRed
        Else
            flg = -1 * (i <= oDic(Target.Text))
            o(Target.Row - i0 + 1)(i).Fill.ForeColor.RGB = RGB(112 * flg + 255 * (1 - flg), 244 * flg + 255 * (1 - flg), 125 * flg + 255 * (1 - flg))
        End If
    Next i
End Sub
[/vba]

Или можно так попробовать, если будете добавлять условия других цветов (сразу для всего кружка в целом)


Много чего не знаю!!!!
 
Ответить
СообщениеGopronotmore,
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim o(), subO() As Shape
Dim n As Long, i&, j&, k&
Dim flg As Integer
Dim oDic As Object
'Создание словаря, где определяются значения (соответствия текста-значению):
Set oDic = CreateObject("Scripting.Dictionary")
oDic.Add "Отсутствует", -1
oDic.Add "Не выполнено", 0
oDic.Add "Выполнено 25%", 1
oDic.Add "Выполнено 50%", 2
oDic.Add "Выполнено 75%", 3
oDic.Add "Выполнено 100%", 4

n = 5 ' количество кружков
i0 = 2
ReDim o(1 To n)
ReDim subO(1 To 4)  ' 4 части кружка
    For i = 1 To n
        For j = 1 To UBound(subO)
            k = k + 1
            Set subO(j) = ActiveSheet.Shapes("_o" & k)
        Next j
        o(i) = subO
    Next i
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = 0 Then
        intCorol = vbWhite
    End If
    For i = 1 To UBound(o(Target.Row - i0 + 1))
        If oDic(Target.Text) = -1 Then
            o(Target.Row - i0 + 1)(i).Fill.ForeColor.RGB = vbRed
        Else
            flg = -1 * (i <= oDic(Target.Text))
            o(Target.Row - i0 + 1)(i).Fill.ForeColor.RGB = RGB(112 * flg + 255 * (1 - flg), 244 * flg + 255 * (1 - flg), 125 * flg + 255 * (1 - flg))
        End If
    Next i
End Sub
[/vba]

Или можно так попробовать, если будете добавлять условия других цветов (сразу для всего кружка в целом)

Автор - Roman777
Дата добавления - 05.02.2019 в 07:45
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Оптимизация кода по графикам (Макросы/Sub)
  • Страница 1 из 2
  • 1
  • 2
  • »
Поиск:

Яндекс цитирования
© 2010-2019 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!