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

Вход

Регистрация

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

 

= Мир MS Excel/Макрос, меняющий цвет шрифта ячейки при совпадении символов - Страница 2 - Мир MS Excel

Старая форма входа
  • Страница 2 из 2
  • «
  • 1
  • 2
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Макрос, меняющий цвет шрифта ячейки при совпадении символов
Макрос, меняющий цвет шрифта ячейки при совпадении символов
ikki Дата: Воскресенье, 13.01.2013, 11:36 | Сообщение № 21
Группа: Друзья
Ранг: Старожил
Сообщений: 1906
Репутация: 504 ±
Замечаний: 0% ±

Excel 2003, 2010
[vba]
Код
Sub t()
       a = [b4:c28].Value
       For i = 1 To UBound(a) - 1
           e = Split(Application.Trim(a(i, 1))): j = i + 1: k = a(i, 2) * 0.3: f = False
           Do Until (j > UBound(a)) Or f
               If a(j, 2) < k Then Exit Do
               x = Split(Application.Trim(a(j, 1)))
               If UBound(x) >= UBound(e) Then
                   ff = True
                   For ie = 0 To UBound(e)
                       ff = True
                       For ix = 0 To UBound(x)
                           If e(ie) = x(ix) Then ff = False: Exit For
                       Next
                       If ff Then Exit For
                   Next
                   If Not ff Then Cells(i + 3, 2).Font.ColorIndex = 15: f = True
               End If
               j = j + 1
           Loop
       Next
End Sub
[/vba]
пс. обратите внимание - первая строка не закрасилась, ибо не попадает в ваши пресловутые 30%

помощь по Excel и VBA
ikki@fxmail.ru, icq 592842413, skype alex.ikki

Сообщение отредактировал ikki - Воскресенье, 13.01.2013, 12:31
 
Ответить
Сообщение[vba]
Код
Sub t()
       a = [b4:c28].Value
       For i = 1 To UBound(a) - 1
           e = Split(Application.Trim(a(i, 1))): j = i + 1: k = a(i, 2) * 0.3: f = False
           Do Until (j > UBound(a)) Or f
               If a(j, 2) < k Then Exit Do
               x = Split(Application.Trim(a(j, 1)))
               If UBound(x) >= UBound(e) Then
                   ff = True
                   For ie = 0 To UBound(e)
                       ff = True
                       For ix = 0 To UBound(x)
                           If e(ie) = x(ix) Then ff = False: Exit For
                       Next
                       If ff Then Exit For
                   Next
                   If Not ff Then Cells(i + 3, 2).Font.ColorIndex = 15: f = True
               End If
               j = j + 1
           Loop
       Next
End Sub
[/vba]
пс. обратите внимание - первая строка не закрасилась, ибо не попадает в ваши пресловутые 30%
Автор - ikki
Дата добавления - 13.01.2013 в 11:36
ikki Дата: Воскресенье, 13.01.2013, 12:30 | Сообщение № 22
Группа: Друзья
Ранг: Старожил
Сообщений: 1906
Репутация: 504 ±
Замечаний: 0% ±

Excel 2003, 2010
другой вариант (в общем-то, не короче и вряд ли быстрее, просто разбираться и править удобнее)

[vba]
Код
Sub tt()
      Set d = CreateObject("scripting.dictionary")
      a = [b4:c28].Value
      For i = 1 To UBound(a) - 1
          e = Split(Application.Trim(a(i, 1)))
          For ie = 0 To UBound(e): d.Item(e(ie)) = 0: Next
          j = i + 1: k = a(i, 2) * 0.3: f = False
          Do Until (j > UBound(a)) Or f
              If a(j, 2) < k Then Exit Do
              x = Split(Application.Trim(a(j, 1)))
              If UBound(x) >= UBound(e) Then
                  ff = True
                  For ix = 0 To UBound(x)
                      If Not d.exists(x(ix)) Then ff = False: Exit For
                  Next
                  If ff Then Cells(i + 3, 2).Font.ColorIndex = 15: f = True
              End If
              j = j + 1
          Loop
          d.RemoveAll
      Next
End Sub
[/vba]

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

помощь по Excel и VBA
ikki@fxmail.ru, icq 592842413, skype alex.ikki

Сообщение отредактировал ikki - Воскресенье, 13.01.2013, 12:35
 
Ответить
Сообщениедругой вариант (в общем-то, не короче и вряд ли быстрее, просто разбираться и править удобнее)

[vba]
Код
Sub tt()
      Set d = CreateObject("scripting.dictionary")
      a = [b4:c28].Value
      For i = 1 To UBound(a) - 1
          e = Split(Application.Trim(a(i, 1)))
          For ie = 0 To UBound(e): d.Item(e(ie)) = 0: Next
          j = i + 1: k = a(i, 2) * 0.3: f = False
          Do Until (j > UBound(a)) Or f
              If a(j, 2) < k Then Exit Do
              x = Split(Application.Trim(a(j, 1)))
              If UBound(x) >= UBound(e) Then
                  ff = True
                  For ix = 0 To UBound(x)
                      If Not d.exists(x(ix)) Then ff = False: Exit For
                  Next
                  If ff Then Cells(i + 3, 2).Font.ColorIndex = 15: f = True
              End If
              j = j + 1
          Loop
          d.RemoveAll
      Next
End Sub
[/vba]

пс. есть нюанс - и в том, и в другом коде. для случая наличия повторяющихся слов в строках может работать неверно. но в примере таких случаев нет smile
Автор - ikki
Дата добавления - 13.01.2013 в 12:30
Викт0р Дата: Воскресенье, 13.01.2013, 14:54 | Сообщение № 23
Группа: Гости
Ikki, спасибо за помощь.

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

Будьте добры, посмотрите файл с макросом. hayabusa-club.ru/macros.xls (это книга с поддержкой макросов, у файла поменяно расширение, т.к. xlsm не скачивается с сервера.)
 
Ответить
СообщениеIkki, спасибо за помощь.

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

Будьте добры, посмотрите файл с макросом. hayabusa-club.ru/macros.xls (это книга с поддержкой макросов, у файла поменяно расширение, т.к. xlsm не скачивается с сервера.)
Автор - Викт0р
Дата добавления - 13.01.2013 в 14:54
Викт0р Дата: Воскресенье, 13.01.2013, 14:56 | Сообщение № 24
Группа: Гости
Второй макрос запустить не получилось. Ошибок не пишет, но и ничего не происходит.
 
Ответить
СообщениеВторой макрос запустить не получилось. Ошибок не пишет, но и ничего не происходит.
Автор - Викт0р
Дата добавления - 13.01.2013 в 14:56
ikki Дата: Воскресенье, 13.01.2013, 15:28 | Сообщение № 25
Группа: Друзья
Ранг: Старожил
Сообщений: 1906
Репутация: 504 ±
Замечаний: 0% ±

Excel 2003, 2010
регистрируйтесь на форуме, прикрепляйте файл - будет разговор.

помощь по Excel и VBA
ikki@fxmail.ru, icq 592842413, skype alex.ikki
 
Ответить
Сообщениерегистрируйтесь на форуме, прикрепляйте файл - будет разговор.
Автор - ikki
Дата добавления - 13.01.2013 в 15:28
Викт0р Дата: Воскресенье, 13.01.2013, 16:21 | Сообщение № 26
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Прикрепил
К сообщению приложен файл: macros1.xlsm (20.8 Kb)
 
Ответить
СообщениеПрикрепил
Автор - Викт0р
Дата добавления - 13.01.2013 в 16:21
ikki Дата: Воскресенье, 13.01.2013, 20:00 | Сообщение № 27
Группа: Друзья
Ранг: Старожил
Сообщений: 1906
Репутация: 504 ±
Замечаний: 0% ±

Excel 2003, 2010
посмотрел.
все претензии можете переадресовать себе обратно. biggrin
диапазон сдвинули, а макрос поменяли лишь частично.

ищем строку
[vba]
Код
If Not ff Then Cells(i + 3, 2).Font.ColorIndex = 15: f = True
[/vba]
и меняем так:
[vba]
Код
If Not ff Then Cells(i + 1, 2).Font.ColorIndex = 15: f = True
[/vba]

помощь по Excel и VBA
ikki@fxmail.ru, icq 592842413, skype alex.ikki
 
Ответить
Сообщениепосмотрел.
все претензии можете переадресовать себе обратно. biggrin
диапазон сдвинули, а макрос поменяли лишь частично.

ищем строку
[vba]
Код
If Not ff Then Cells(i + 3, 2).Font.ColorIndex = 15: f = True
[/vba]
и меняем так:
[vba]
Код
If Not ff Then Cells(i + 1, 2).Font.ColorIndex = 15: f = True
[/vba]
Автор - ikki
Дата добавления - 13.01.2013 в 20:00
Викт0р Дата: Воскресенье, 13.01.2013, 23:03 | Сообщение № 28
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Большое спасибо!

Если я хочу расширить диапазон строк листа до 1000, эта строка кода макроса останется в таком же виде?
Код
If Not ff Then Cells(i + 1, 2).Font.ColorIndex = 15: f = True


В этом я чайник и в инструкции ответ не нашел, но пожалуйста поделитесь чем отличается
Код
Then Cells(i + 3, 2)
от
Код
Then Cells(i + 1, 2)


Вам + в репу)).

С удовольствием вас отблагодарю. Могу ответить на юридический вопрос или нарисовать картинку в ФШ.


Сообщение отредактировал Викт0р - Воскресенье, 13.01.2013, 23:06
 
Ответить
СообщениеБольшое спасибо!

Если я хочу расширить диапазон строк листа до 1000, эта строка кода макроса останется в таком же виде?
Код
If Not ff Then Cells(i + 1, 2).Font.ColorIndex = 15: f = True


В этом я чайник и в инструкции ответ не нашел, но пожалуйста поделитесь чем отличается
Код
Then Cells(i + 3, 2)
от
Код
Then Cells(i + 1, 2)


Вам + в репу)).

С удовольствием вас отблагодарю. Могу ответить на юридический вопрос или нарисовать картинку в ФШ.
Автор - Викт0р
Дата добавления - 13.01.2013 в 23:03
ikki Дата: Воскресенье, 13.01.2013, 23:09 | Сообщение № 29
Группа: Друзья
Ранг: Старожил
Сообщений: 1906
Репутация: 504 ±
Замечаний: 0% ±

Excel 2003, 2010
ну, в общем можно немножко переписать макрос - и тогда с этим заморачиваться не придётся.
а пока - число, которое прибавляется в этой строке к i - это, по сути, число строк, на которое сдвинуто начало диапазона от первой строки листа.
т.е. № первой строки диапазона минус единица.

в вашем первом примере данные начинались с 4-й строки - поэтому прибавляли 3.
во втором - со второй, поэтому прибавляем 1.

помощь по Excel и VBA
ikki@fxmail.ru, icq 592842413, skype alex.ikki
 
Ответить
Сообщениену, в общем можно немножко переписать макрос - и тогда с этим заморачиваться не придётся.
а пока - число, которое прибавляется в этой строке к i - это, по сути, число строк, на которое сдвинуто начало диапазона от первой строки листа.
т.е. № первой строки диапазона минус единица.

в вашем первом примере данные начинались с 4-й строки - поэтому прибавляли 3.
во втором - со второй, поэтому прибавляем 1.
Автор - ikki
Дата добавления - 13.01.2013 в 23:09
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Макрос, меняющий цвет шрифта ячейки при совпадении символов
  • Страница 2 из 2
  • «
  • 1
  • 2
Поиск:

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