Доработка Генератор случайных чисел в диапазоне

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Доработка Генератор случайных чисел в диапазоне (Макросы Sub)

Rama

Дата: Пятница, 04.10.2013, 20:48 | Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 59

Репутация: 0 ±

Замечаний: 20% ±

2010

Прошу помочь доработать макрос.
Данный макрос проставляет случайные числа в выделенном диапазоне и раскрашивает шрифт.
Хочется увидеть возможность добавить:
- Расскрасить Цвет ячеек
- Жирный/Не жирный шрифт
- Размер шрифта[vba]

Код

Sub ГенераторСлучЧисел()
Dim aCell As Range, mR As Range
Set mR = Selection '

For Each aCell In mR.Cells
aCell = CInt(1 + 200 * Rnd) ' Диапозон от 1 до 200
'диапозон выделения цветом НАЧАЛО------------
Select Case aCell
Case Is < 50: aCell.Font.Color = vbBlue ' Условие выделения цветом если меньше 50
Case Is < 100: aCell.Font.Color = vbRed ' Условие выделения цветом если больше 100
Case Is < 200: aCell.Font.Color = vbBlack ' Условие выделения цветом если больше 200
Case Else
aCell.Font.Color = vbBlack ' остальные числа (vbRed, vbYellow, vbGreen, vbBlack, vbGreen, vbBlack, vbGreen, vbBlack) '(массив цветов)
End Select
'диапозон выделения цветом КОНЕЦ------------
Next

Set mR = Nothing
End Sub

[/vba]

Сообщение отредактировал Rama - Суббота, 05.10.2013, 09:48

Ответить

RAN

Дата: Пятница, 04.10.2013, 21:00 | Сообщение № 2

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Запишите макрорекордером эти действия, и получите требуемые параметры. Дабы было проще ориентироваться - запишите замену цвета текста (это есть в макросе).

Быть или не быть, вот в чем загвоздка!

Ответить

Rama

Дата: Суббота, 05.10.2013, 00:21 | Сообщение № 3

Группа: Пользователи

Ранг: Участник

Сообщений: 59

Репутация: 0 ±

Замечаний: 20% ±

2010

Не получается немного. На весь диапазон распространяется только первое условие (до 50), остальные не подключаются.
Я хочу, что бы на каждый интервал был свой шрифт, размер и цвет шрифта.

[vba]

Код

Sub ГенераторСлучЧисел()
Dim aCell As Range, mR As Range
      Set mR = Selection '

For Each aCell In mR.Cells
      aCell = CInt(1 + 200 * Rnd) ' Диапозон от 1 до 200
      'диапозон выделения НАЧАЛО------------
      Select Case aCell 'первый диапозон чисел до 50
          Case Is <= 50: aCell.Font.Color = vbBlue  ' Условие выделения цветом если ...
          Selection.Font.Bold = True 'жирный
      With Selection.Font
          .Name = "Cambria" 'шрифт
          .Size = 15 'размер
      End With

          Case Is < 100: aCell.Font.Color = vbRed  ' Условие выделения цветом если ...
          Selection.Font.Bold = False 'НЕ жирный
      With Selection.Font
          .Name = "Edwardian Script ITC"
          .Size = 12
      End With

          Case Is < 200: aCell.Font.Color = vbBlack  ' Условие выделения цветом если ...
          Selection.Font.Bold = False 'жирный
      With Selection.Font
          .Name = "Goudy Stout" 'шрифт
          .Size = 10 'размер
      End With
          Case Else
              aCell.Font.Color = vbBlack   ' остальные(vbRed, vbYellow, vbGreen, vbBlack, vbGreen, vbBlack, vbGreen, vbBlack) '(массив цветов)
      End Select
      'диапозон выделения КОНЕЦ------------
Next

Set mR = Nothing
End Sub

[/vba]

Код

[/vba]Rama

Сообщение отредактировал Rama - Суббота, 05.10.2013, 00:21

Ответить

СообщениеНе получается немного. На весь диапазон распространяется только первое условие (до 50), остальные не подключаются.
Я хочу, что бы на каждый интервал был свой шрифт, размер и цвет шрифта.

[vba]

Код

[/vba]

Автор - Rama
Дата добавления - 05.10.2013 в 00:21

SkyPro

Дата: Суббота, 05.10.2013, 00:30 | Сообщение № 4

Группа: Друзья

Ранг: Старожил

Сообщений: 1206

Репутация: 255 ±

Замечаний: 0% ±

2010

У вас выполняется последнее условие, так как какое число не возьми от 1 до 200, оно будет < 200.
Вы бы хоть логику включили что-ли =\

[vba]

Код

Sub ГенераторСлучЧисел()
Dim aCell As Range, mR As Range
       Set mR = Selection '

For Each aCell In mR.Cells
       aCell = CInt(1 + 200 * Rnd) ' Диапозон от 1 до 200
       'диапозон выделения НАЧАЛО------------
       Select Case aCell 'первый диапозон чисел до 50
           Case Is <= 50: aCell.Font.Color = vbBlue  ' Условие выделения цветом если ...
           Selection.Font.Bold = True 'жирный
       With Selection.Font
           .Name = "Cambria" 'шрифт
           .Size = 15 'размер
       End With

           Case Is > 50 <= 100: aCell.Font.Color = vbRed ' Условие выделения цветом если ...
           Selection.Font.Bold = False 'НЕ жирный
       With Selection.Font
           .Name = "Edwardian Script ITC"
           .Size = 12
       End With

           Case Is > 100 <= 200: aCell.Font.Color = vbBlack ' Условие выделения цветом если ...
           Selection.Font.Bold = False 'жирный
       With Selection.Font
           .Name = "Goudy Stout" 'шрифт
           .Size = 10 'размер
       End With
           Case Else
               aCell.Font.Color = vbBlack   ' остальные(vbRed, vbYellow, vbGreen, vbBlack, vbGreen, vbBlack, vbGreen, vbBlack) '(массив цветов)
       End Select
       'диапозон выделения КОНЕЦ------------
Next

Set mR = Nothing
End Sub

[/vba]

Код

Sub ГенераторСлучЧисел()
Dim aCell As Range, mR As Range
       Set mR = Selection '

For Each aCell In mR.Cells
       aCell = CInt(1 + 200 * Rnd) ' Диапозон от 1 до 200
       'диапозон выделения НАЧАЛО------------
       Select Case aCell 'первый диапозон чисел до 50
           Case Is <= 50: aCell.Font.Color = vbBlue  ' Условие выделения цветом если ...
           Selection.Font.Bold = True 'жирный
       With Selection.Font
           .Name = "Cambria" 'шрифт
           .Size = 15 'размер
       End With

           Case Is > 50 <= 100: aCell.Font.Color = vbRed ' Условие выделения цветом если ...
           Selection.Font.Bold = False 'НЕ жирный
       With Selection.Font
           .Name = "Edwardian Script ITC"
           .Size = 12
       End With

           Case Is > 100 <= 200: aCell.Font.Color = vbBlack ' Условие выделения цветом если ...
           Selection.Font.Bold = False 'жирный
       With Selection.Font
           .Name = "Goudy Stout" 'шрифт
           .Size = 10 'размер
       End With
           Case Else
               aCell.Font.Color = vbBlack   ' остальные(vbRed, vbYellow, vbGreen, vbBlack, vbGreen, vbBlack, vbGreen, vbBlack) '(массив цветов)
       End Select
       'диапозон выделения КОНЕЦ------------
Next

Set mR = Nothing
End Sub

[/vba]SkyPro

skypro1111@gmail.com

Сообщение отредактировал SkyPro - Суббота, 05.10.2013, 00:33

Ответить

СообщениеУ вас выполняется последнее условие, так как какое число не возьми от 1 до 200, оно будет < 200.
Вы бы хоть логику включили что-ли =\

[vba]

Код

Sub ГенераторСлучЧисел()
Dim aCell As Range, mR As Range
       Set mR = Selection '

For Each aCell In mR.Cells
       aCell = CInt(1 + 200 * Rnd) ' Диапозон от 1 до 200
       'диапозон выделения НАЧАЛО------------
       Select Case aCell 'первый диапозон чисел до 50
           Case Is <= 50: aCell.Font.Color = vbBlue  ' Условие выделения цветом если ...
           Selection.Font.Bold = True 'жирный
       With Selection.Font
           .Name = "Cambria" 'шрифт
           .Size = 15 'размер
       End With

           Case Is > 50 <= 100: aCell.Font.Color = vbRed ' Условие выделения цветом если ...
           Selection.Font.Bold = False 'НЕ жирный
       With Selection.Font
           .Name = "Edwardian Script ITC"
           .Size = 12
       End With

           Case Is > 100 <= 200: aCell.Font.Color = vbBlack ' Условие выделения цветом если ...
           Selection.Font.Bold = False 'жирный
       With Selection.Font
           .Name = "Goudy Stout" 'шрифт
           .Size = 10 'размер
       End With
           Case Else
               aCell.Font.Color = vbBlack   ' остальные(vbRed, vbYellow, vbGreen, vbBlack, vbGreen, vbBlack, vbGreen, vbBlack) '(массив цветов)
       End Select
       'диапозон выделения КОНЕЦ------------
Next

Set mR = Nothing
End Sub

[/vba]

Автор - SkyPro
Дата добавления - 05.10.2013 в 00:30

Rama

Дата: Суббота, 05.10.2013, 00:39 | Сообщение № 5

Группа: Пользователи

Ранг: Участник

Сообщений: 59

Репутация: 0 ±

Замечаний: 20% ±

2010

Ваш вариант не работает. Он все "красит" по второму условию.

Ответить

SkyPro

Дата: Суббота, 05.10.2013, 00:56 | Сообщение № 6

Группа: Друзья

Ранг: Старожил

Сообщений: 1206

Репутация: 255 ±

Замечаний: 0% ±

2010

Вот:[vba]

Код

Sub ГенераторСлучЧисел()
Dim aCell As Range, mR As Range
      Set mR = Selection '

For Each aCell In mR.Cells
      aCell = CInt(1 + 200 * Rnd) ' Диапозон от 1 до 200
      'диапозон выделения НАЧАЛО------------
      Select Case aCell.Value 'первый диапозон чисел до 50
          Case 1 To 50: aCell.Font.Color = vbBlue  ' Условие выделения цветом если ...
          aCell.Font.Bold = True 'жирный
      With Selection.Font
          .Name = "Cambria" 'шрифт
          .Size = 15 'размер
      End With

          Case 51 To 100: aCell.Font.Color = vbRed ' Условие выделения цветом если ...
          aCell.Font.Bold = False 'НЕ жирный
      With aCell.Font
          .Name = "Edwardian Script ITC"
          .Size = 12
      End With

          Case 101 To 200: aCell.Font.Color = vbYellow ' Условие выделения цветом если ...
          aCell.Font.Bold = False 'жирный
      With aCell.Font
          .Name = "Goudy Stout" 'шрифт
          .Size = 10 'размер
      End With
          Case Else
              aCell.Font.Color = vbBlack   ' остальные(vbRed, vbYellow, vbGreen, vbBlack, vbGreen, vbBlack, vbGreen, vbBlack) '(массив цветов)
      End Select
      'диапозон выделения КОНЕЦ------------
Next

Set mR = Nothing
End Sub

[/vba]
[offtop]
Пора выспаться за всю неделю.

skypro1111@gmail.com

Сообщение отредактировал SkyPro - Суббота, 05.10.2013, 00:59

Ответить

Rama

Дата: Суббота, 05.10.2013, 01:11 | Сообщение № 7

Группа: Пользователи

Ранг: Участник

Сообщений: 59

Репутация: 0 ±

Замечаний: 20% ±

2010

Ваш вариант не работает. Все ячейки одного шрифта и размера (кроме последней строки почему то...)

Сообщение отредактировал Rama - Суббота, 05.10.2013, 01:13

Ответить

Доработка Генератор случайных чисел в диапазоне (Макросы Sub)

Страница 1 из 1
1