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

Вход

Регистрация

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

 

= Мир MS Excel/Внешний вид данных - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Внешний вид данных (Макросы/Sub)
Внешний вид данных
artika2000 Дата: Четверг, 10.08.2017, 13:37 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 66
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Здравствуйте!
Прошу помочь мне привести в удобочитаемый вид данные, расположенные в разных частях таблицы в приложенном архиве pantone
Пытаюсь приблизиться в подаче внешней информации максимально как на фото, файл - цифровой аналог веера.
С уважением, Артем
К сообщению приложен файл: pantone.zip(65Kb) · 8664994.jpg(47Kb)
 
Ответить
СообщениеЗдравствуйте!
Прошу помочь мне привести в удобочитаемый вид данные, расположенные в разных частях таблицы в приложенном архиве pantone
Пытаюсь приблизиться в подаче внешней информации максимально как на фото, файл - цифровой аналог веера.
С уважением, Артем

Автор - artika2000
Дата добавления - 10.08.2017 в 13:37
_Igor_61 Дата: Четверг, 10.08.2017, 14:11 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 191
Репутация: 34 ±
Замечаний: 0% ±

Excel 2007
Здравствуйте! Как мне кажется, Вы немного не в ту сторону двигаетесь - нет никакой гарантии, что производители ОС в ближайшее время не изменят коды RGB или еще что-то, связанное с цветовой палитрой. Может, лучше отталкиваться не от цвета, а от значений? Как они формируются? Либо макросом определять цвет RGB и потом его применять к нужным ячейкам.


Сообщение отредактировал _Igor_61 - Четверг, 10.08.2017, 14:13
 
Ответить
СообщениеЗдравствуйте! Как мне кажется, Вы немного не в ту сторону двигаетесь - нет никакой гарантии, что производители ОС в ближайшее время не изменят коды RGB или еще что-то, связанное с цветовой палитрой. Может, лучше отталкиваться не от цвета, а от значений? Как они формируются? Либо макросом определять цвет RGB и потом его применять к нужным ячейкам.

Автор - _Igor_61
Дата добавления - 10.08.2017 в 14:11
artika2000 Дата: Четверг, 10.08.2017, 14:18 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 66
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
_Igor_61, Да Вы правы, в файле именно макросом по RGB придаются значения на листе Pantone? там скрыто 3 столбца со значениями цифровыми RGB


Сообщение отредактировал artika2000 - Четверг, 10.08.2017, 14:20
 
Ответить
Сообщение_Igor_61, Да Вы правы, в файле именно макросом по RGB придаются значения на листе Pantone? там скрыто 3 столбца со значениями цифровыми RGB

Автор - artika2000
Дата добавления - 10.08.2017 в 14:18
sboy Дата: Четверг, 10.08.2017, 14:19 | Сообщение № 4
Группа: Проверенные
Ранг: Старожил
Сообщений: 1014
Репутация: 255 ±
Замечаний: 0% ±

Excel 2010
Если правильно понял. (обработку, если введено отсутствующее значение не делал)[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$12" Then Exit Sub
If Target = Empty Then Exit Sub
With Sheets("Pantone")
  Set fc = .Range("A:A").Find(what:=Target.Value, lookat:=xlWhole)
    If Not fc Is Nothing Then
    Target.Interior.Color = fc.Interior.Color
        For ic = 5 To 19
            If .Cells(fc.Row, ic) > 0 Then
                Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value
                Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic)
                x = x + 1
            End If
        Next ic
    End If
End With
End Sub
[/vba]
К сообщению приложен файл: _pantone.zip(65Kb)
 
Ответить
СообщениеЕсли правильно понял. (обработку, если введено отсутствующее значение не делал)[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$12" Then Exit Sub
If Target = Empty Then Exit Sub
With Sheets("Pantone")
  Set fc = .Range("A:A").Find(what:=Target.Value, lookat:=xlWhole)
    If Not fc Is Nothing Then
    Target.Interior.Color = fc.Interior.Color
        For ic = 5 To 19
            If .Cells(fc.Row, ic) > 0 Then
                Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value
                Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic)
                x = x + 1
            End If
        Next ic
    End If
End With
End Sub
[/vba]

Автор - sboy
Дата добавления - 10.08.2017 в 14:19
artika2000 Дата: Четверг, 10.08.2017, 14:23 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 66
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
sboy, Открыл Ваш файл, у меня вот так, с чем это может связано быть
К сообщению приложен файл: 5738826.png(46Kb)
 
Ответить
Сообщениеsboy, Открыл Ваш файл, у меня вот так, с чем это может связано быть

Автор - artika2000
Дата добавления - 10.08.2017 в 14:23
artika2000 Дата: Четверг, 10.08.2017, 14:30 | Сообщение № 6
Группа: Пользователи
Ранг: Участник
Сообщений: 66
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
sboy, Спасибо Вам Вы все правильно поняли. Есть один момент, доделать, я все равно сходу не смогу. Все правильно работает, только как при каждом последующем наборе номера, если он состоит из 2х красок - а предидущий из 4-х, 3-я и 4-ая краски - остаются от старых значений в ячейках, а их бы убирать оттуда
 
Ответить
Сообщениеsboy, Спасибо Вам Вы все правильно поняли. Есть один момент, доделать, я все равно сходу не смогу. Все правильно работает, только как при каждом последующем наборе номера, если он состоит из 2х красок - а предидущий из 4-х, 3-я и 4-ая краски - остаются от старых значений в ячейках, а их бы убирать оттуда

Автор - artika2000
Дата добавления - 10.08.2017 в 14:30
sboy Дата: Четверг, 10.08.2017, 14:37 | Сообщение № 7
Группа: Проверенные
Ранг: Старожил
Сообщений: 1014
Репутация: 255 ±
Замечаний: 0% ±

Excel 2010
artika2000, добавил
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$12" Then Exit Sub
If Target = Empty Then Exit Sub
Range("A14:B20").ClearContents
With Sheets("Pantone")
  Set fc = .Range("A:A").Find(what:=Target.Value, lookat:=xlWhole)
    If Not fc Is Nothing Then
    Target.Interior.Color = fc.Interior.Color
        For ic = 5 To 19
            If .Cells(fc.Row, ic) > 0 Then
                Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value
                Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic)
                x = x + 1
            End If
        Next ic
    End If
End With
End Sub
[/vba]
К сообщению приложен файл: 4400667.zip(63Kb)
 
Ответить
Сообщениеartika2000, добавил
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$12" Then Exit Sub
If Target = Empty Then Exit Sub
Range("A14:B20").ClearContents
With Sheets("Pantone")
  Set fc = .Range("A:A").Find(what:=Target.Value, lookat:=xlWhole)
    If Not fc Is Nothing Then
    Target.Interior.Color = fc.Interior.Color
        For ic = 5 To 19
            If .Cells(fc.Row, ic) > 0 Then
                Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value
                Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic)
                x = x + 1
            End If
        Next ic
    End If
End With
End Sub
[/vba]

Автор - sboy
Дата добавления - 10.08.2017 в 14:37
artika2000 Дата: Четверг, 10.08.2017, 14:47 | Сообщение № 8
Группа: Пользователи
Ранг: Участник
Сообщений: 66
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
sboy, Спасибо Вам! остальное сделаю, благодарю Вас.
С уважением, Артем
 
Ответить
Сообщениеsboy, Спасибо Вам! остальное сделаю, благодарю Вас.
С уважением, Артем

Автор - artika2000
Дата добавления - 10.08.2017 в 14:47
artika2000 Дата: Четверг, 10.08.2017, 15:49 | Сообщение № 9
Группа: Пользователи
Ранг: Участник
Сообщений: 66
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
sboy, Скажите пожалуйста если сможете, как на листе несколько Private Sub Worksheet_Change(ByVal Target As Range) обозначить. Цель: рядом еще такой же фрагмент хочу, делаю по подобию - не знаю как несколько Private Sub Worksheet_Change(ByVal Target As Range) разместить?
 
Ответить
Сообщениеsboy, Скажите пожалуйста если сможете, как на листе несколько Private Sub Worksheet_Change(ByVal Target As Range) обозначить. Цель: рядом еще такой же фрагмент хочу, делаю по подобию - не знаю как несколько Private Sub Worksheet_Change(ByVal Target As Range) разместить?

Автор - artika2000
Дата добавления - 10.08.2017 в 15:49
_Boroda_ Дата: Четверг, 10.08.2017, 16:03 | Сообщение № 10
Группа: Модераторы
Ранг: Местный житель
Сообщений: 11545
Репутация: 4754 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Никак.
Все нужно засовывать вовнутрь одного


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеНикак.
Все нужно засовывать вовнутрь одного

Автор - _Boroda_
Дата добавления - 10.08.2017 в 16:03
Udik Дата: Четверг, 10.08.2017, 16:11 | Сообщение № 11
Группа: Друзья
Ранг: Старожил
Сообщений: 1589
Репутация: 192 ±
Замечаний: 0% ±

Excel 2016 х 64
несколько макросов одного события никак :p Но можно в зависимости от адреса разные ветки выполнять.
тут дописать доп. адрес или диапазон
[vba]
Код

If Target.Address <> "$A$12" Then
[/vba]
А потом в зависимости от адреса делать что-то (If .. then..else)


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
Сообщениенесколько макросов одного события никак :p Но можно в зависимости от адреса разные ветки выполнять.
тут дописать доп. адрес или диапазон
[vba]
Код

If Target.Address <> "$A$12" Then
[/vba]
А потом в зависимости от адреса делать что-то (If .. then..else)

Автор - Udik
Дата добавления - 10.08.2017 в 16:11
artika2000 Дата: Четверг, 10.08.2017, 16:19 | Сообщение № 12
Группа: Пользователи
Ранг: Участник
Сообщений: 66
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
_Boroda_, Udik, Да спасибо почитал уже про это.

[vba]
Код
If Target.Address <> "$A$12" Then Exit Sub
If Target = Empty Then Exit Sub
Range("A14:B20").ClearContents
With Sheets("Pantone")
  Set fc = .Range("A:A").Find(what:=Target.Value, lookat:=xlWhole)
    If Not fc Is Nothing Then
    Target.Interior.Color = fc.Interior.Color
        For ic = 5 To 19
            If .Cells(fc.Row, ic) > 0 Then
                Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value
                Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic)
                x = x + 1
            End If
        Next ic
    End If
End With
If Target.Address <> "$D$12" Then Exit Sub
If Target = Empty Then Exit Sub
Range("D14:C20").ClearContents
With Sheets("Pantone")
  Set fc = .Range("A:A").Find(what:=Target.Value, lookat:=xlWhole)
    If Not fc Is Nothing Then
    Target.Interior.Color = fc.Interior.Color
        For ic = 5 To 19
            If .Cells(fc.Row, ic) > 0 Then
                Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value
                Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic)
                x = x + 1
            End If
        Next ic
    End If
End With
End Sub
[/vba]

Скажите при внесении информации в D12 жду появления в интервале D14:C20 не получаю ничего - зря жду?
 
Ответить
Сообщение_Boroda_, Udik, Да спасибо почитал уже про это.

[vba]
Код
If Target.Address <> "$A$12" Then Exit Sub
If Target = Empty Then Exit Sub
Range("A14:B20").ClearContents
With Sheets("Pantone")
  Set fc = .Range("A:A").Find(what:=Target.Value, lookat:=xlWhole)
    If Not fc Is Nothing Then
    Target.Interior.Color = fc.Interior.Color
        For ic = 5 To 19
            If .Cells(fc.Row, ic) > 0 Then
                Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value
                Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic)
                x = x + 1
            End If
        Next ic
    End If
End With
If Target.Address <> "$D$12" Then Exit Sub
If Target = Empty Then Exit Sub
Range("D14:C20").ClearContents
With Sheets("Pantone")
  Set fc = .Range("A:A").Find(what:=Target.Value, lookat:=xlWhole)
    If Not fc Is Nothing Then
    Target.Interior.Color = fc.Interior.Color
        For ic = 5 To 19
            If .Cells(fc.Row, ic) > 0 Then
                Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value
                Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic)
                x = x + 1
            End If
        Next ic
    End If
End With
End Sub
[/vba]

Скажите при внесении информации в D12 жду появления в интервале D14:C20 не получаю ничего - зря жду?

Автор - artika2000
Дата добавления - 10.08.2017 в 16:19
_Boroda_ Дата: Четверг, 10.08.2017, 16:20 | Сообщение № 13
Группа: Модераторы
Ранг: Местный житель
Сообщений: 11545
Репутация: 4754 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
If Target.Address <> "$A$12" Then Exit Sub

Если не А12, то выход из макроса

Перепишите по типу
[vba]
Код
If Target.Address = "$A$12" Then
...
End if
If Target.Address = "$D$12" Then
...
End if
[/vba]
Или Селект Кейс используйте


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение
If Target.Address <> "$A$12" Then Exit Sub

Если не А12, то выход из макроса

Перепишите по типу
[vba]
Код
If Target.Address = "$A$12" Then
...
End if
If Target.Address = "$D$12" Then
...
End if
[/vba]
Или Селект Кейс используйте

Автор - _Boroda_
Дата добавления - 10.08.2017 в 16:20
artika2000 Дата: Четверг, 10.08.2017, 16:48 | Сообщение № 14
Группа: Пользователи
Ранг: Участник
Сообщений: 66
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
_Boroda_, как всегда спасибо Вам
К сообщению приложен файл: 7511219.png(43Kb)
 
Ответить
Сообщение_Boroda_, как всегда спасибо Вам

Автор - artika2000
Дата добавления - 10.08.2017 в 16:48
_Boroda_ Дата: Четверг, 10.08.2017, 17:07 | Сообщение № 15
Группа: Модераторы
Ранг: Местный житель
Сообщений: 11545
Репутация: 4754 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Это не мне, это Сергею sboy спасибо. Я только кусочек в его макросе изменил
Кстати, наверное вот так тогда (или типа того, я на ходу пишу, могу где-то накосячить)
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Empty Then Exit Sub
ta_=Target.Address(0,0)
If ta_ = "A12" or ta_ = "D12" or ta_ = "G12" or ta_ = "J12" Then
Target.offset(2).resize(7,2).ClearContents
With Sheets("Pantone")
Set fc = .Range("A:A").Find(what:=Target.Value, lookat:=xlWhole)
    If Not fc Is Nothing Then
    Target.Interior.Color = fc.Interior.Color
        For ic = 5 To 19
            If .Cells(fc.Row, ic) > 0 Then
                Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value
                Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic)
                x = x + 1
            End If
        Next ic
    End If
End With
End If
End Sub
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеЭто не мне, это Сергею sboy спасибо. Я только кусочек в его макросе изменил
Кстати, наверное вот так тогда (или типа того, я на ходу пишу, могу где-то накосячить)
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Empty Then Exit Sub
ta_=Target.Address(0,0)
If ta_ = "A12" or ta_ = "D12" or ta_ = "G12" or ta_ = "J12" Then
Target.offset(2).resize(7,2).ClearContents
With Sheets("Pantone")
Set fc = .Range("A:A").Find(what:=Target.Value, lookat:=xlWhole)
    If Not fc Is Nothing Then
    Target.Interior.Color = fc.Interior.Color
        For ic = 5 To 19
            If .Cells(fc.Row, ic) > 0 Then
                Target.Offset(2 + x, 0).Value = .Cells(1, ic).Value
                Target.Offset(2 + x, 1).Value = .Cells(fc.Row, ic)
                x = x + 1
            End If
        Next ic
    End If
End With
End If
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 10.08.2017 в 17:07
artika2000 Дата: Четверг, 10.08.2017, 17:31 | Сообщение № 16
Группа: Пользователи
Ранг: Участник
Сообщений: 66
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
sboy, _Boroda_, спасибо!
 
Ответить
Сообщениеsboy, _Boroda_, спасибо!

Автор - artika2000
Дата добавления - 10.08.2017 в 17:31
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Внешний вид данных (Макросы/Sub)
Страница 1 из 11
Поиск:

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