Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Копирование из одного столбца в другой при помощи макроса
 
#1
20.01.2012 22:43:38
Здравствуйте! у меня такая задача, есть три столбца с данными в одном из них ячейки с    
условным форматированием в виде значков, требуется совершать копирование из одного  
столбца в другой в зависимости от значков в третьем.  
 
только есть условие,    
за исключением двух столбцов книга должна использоваться в защищенном виде,    
в таком режиме допустим копирование из не защищенной ячейки в не защищенную макросом работает, а вот использование фильтра нет, не смотря на то что при защите листа было  
разрешено использование фильтра (поставлена соответствующая галочка).  
 
Подскажите как можно решить эту задачу макросом, если вообще можно.
 
 
 
#2
20.01.2012 23:11:21
Макрос  
Sub perenos()  
Dim i As Long  
Application.ScreenUpdating = 0  
For i = 5 To Cells(Rows.Count, 8).End(xlUp).Row  
If Cells(i, 7) < 100 Then Cells(i, 4) = Cells(i, 8)  
Next  
Application.ScreenUpdating = 1  
End Sub
 
 
 
#3
20.01.2012 23:59:16
Высший пилотаж! Спасибо!
 
 
 
#4
21.01.2012 01:53:08
Прошу прощения за поспешность, тут возникла маленькая проблеммка, ваш макрос  
определяет копирование по значению <100 а в моей таблице имеются значения меньше  
чем 100 но со значком галочка, просто разные значения без значков которые переносить не нужно, так получилось что в  
примере их не оказалось, не продумал, может как нибудь можно задействовать именно значки?  
 
Пример изменил
 
 
 
#5
21.01.2012 09:35:16
Именно значки использовать не получится. В новом файле у Вас к одной части ячеек применено одно условие в УФ, к другой части совсем другое условие в УФ.  
Заранее известно в какой части какое будет условие УФ?
 
 
 
#6
21.01.2012 09:58:00
В том то и дело что всего около 400 позиций с индивидуальным УФ.
 
 
 
#7
22.01.2012 11:02:30
Получается ни какого способа решения этой задачи нет?
 
 
 
#8
22.01.2012 11:54:07
Может и есть, но не все могут Ваш файл посмотреть. Не задумывались над этим? Кстати, Правила форума читали?
 
 
 
#9
22.01.2012 12:22:10
{quote}{login=sanhasan}{date=22.01.2012 11:02}{thema=}{post}Получается ни какого способа решения этой задачи нет?{/post}{/quote}  
Однако, почему бы условия УФ не выразить дополнительно в дополнительном поле, и уже по нему "извращаться"? Далее -  есть ли резон резать таблицу пустывми строками?.. И еще, имхо, есть ли надобность в одну кучу (поле) валить фунты, ойро, баксы, рваные и пр.? Мо быть иметь нормальный лист для нормальной работы, а второй - для отчето-показухи с веселыми картинками?..    
-31781-
 
 
 
#10
22.01.2012 14:02:53
Попробуйте так  
Sub perenos()  
   Dim i As Long  
   Application.ScreenUpdating = 0  
       For i = 5 To Cells(Rows.Count, 7).End(xlUp).Row  
       If Cells(i, 7) < Cells(i, 7).FormatConditions(1).IconCriteria(3).Value Then Cells(i, 4) = Cells(i, 8)  
       Next  
   Application.ScreenUpdating = 1  
End Sub
 
 
 
#11
23.01.2012 01:34:05
{quote}{login=sva}{date=22.01.2012 02:02}{thema=}{post}Попробуйте так  
Sub perenos()  
   Dim i As Long  
   Application.ScreenUpdating = 0  
       For i = 5 To Cells(Rows.Count, 7).End(xlUp).Row  
       If Cells(i, 7) < Cells(i, 7).FormatConditions(1).IconCriteria(3).Value Then Cells(i, 4) = Cells(i, 8)  
       Next  
   Application.ScreenUpdating = 1  
End Sub{/post}{/quote}  
 
 
Макрос работает исключительно в рамках примера, стоит поменять несколько    
значений в столбце G и копирование происходит не так как планировалось  
появляется ошибка Run time error '9'  Subscript out of Range.  
 
По видимому надо исхитрятся как то по другому, но по значкам конечно  
самый прямой путь. Позиций много и УФ настроено корректно на каждую  
смысл вообще такой, формировка в столбце G происходит автоматически в зависимости от поступлений и списаний со склада, на складе много разношорстных  
позиций количество которых нужно время от времени поддерживать заказами,  требуемое количество у каждой позиции своё, и как только у той или иной  
позиции количество становится ниже заданного в ячейке появляется соответствующий  
значек, так вот моя задача сделать так чтоб при нажатии на кнопку формировался  
список с определенными значками, проще говоря список того что необходимо заказать.
 
 
 
#12
23.01.2012 02:06:43
{quote}{login=Юрий М}{date=22.01.2012 11:54}{thema=}{post}Может и есть, но не все могут Ваш файл посмотреть. Не задумывались над этим? Кстати, Правила форума читали?{/post}{/quote}  
Дело в том, что в моём примере используется условное форматирование со значками  
я подумал что они не поддерживаются, или не корректно отображаются в ранних  
версиях Excel  
 
Вот файл версии 2003.
 
 
 
#13
23.01.2012 02:30:19
{quote}{login=Z}{date=22.01.2012 12:22}{thema=Re: }{post}{quote}{login=sanhasan}{date=22.01.2012 11:02}{thema=}{post}Получается ни какого способа решения этой задачи нет?{/post}{/quote}  
Однако, почему бы условия УФ не выразить дополнительно в дополнительном поле, и уже по нему "извращаться"? Далее -  есть ли резон резать таблицу пустывми строками?.. И еще, имхо, есть ли надобность в одну кучу (поле) валить фунты, ойро, баксы, рваные и пр.? Мо быть иметь нормальный лист для нормальной работы, а второй - для отчето-показухи с веселыми картинками?..    
-31781-{/post}{/quote}  
Я конечно могу ответить на ваши вопросы, но думаю они относятся не к этой теме, скажу лиж что и пустые строки и всё остолное не просто так  
а для того что очень удобно, осталось только решить вопрос по теме.
 
 
 
#14
23.01.2012 07:32:54
>>стоит поменять несколько  
>>значений в столбце G и копирование происходит не так как планировалось  
>>появляется ошибка Run time error '9' Subscript out of Range  
 
Покажите как вы меняете значения, т.к. у меня все работает.
 
 
 
#15
23.01.2012 15:03:45
1. Добавляете в таблицу 2 графы с пороговыми значениями (1 - для крестика, 2 - для воскл. знака)  
2. в усл. форматировании (если необходимость еще не отпадет для него) -- ставите ОДИНАКОВУЮ формулу на весь столбец и сравниваете не с константами, а со значениями в доп. столбцах.  
3.  Тогда можно обойтись без макросов с простейшей формулой в "Кол-во" == если(пороговое значение>склад;"Заказ";""(или 0 -- как больше походит)).  
 
ЗЫ: не забывайте что макросы убивают возможность Undo
 
 
 
#16
24.01.2012 01:41:07
{quote}{login=sva}{date=23.01.2012 07:32}{thema=}{post}>>стоит поменять несколько  
>>значений в столбце G и копирование происходит не так как планировалось  
>>появляется ошибка Run time error '9' Subscript out of Range  
 
Покажите как вы меняете значения, т.к. у меня все работает.{/post}{/quote}  
 
Да в примере все работает, а в рабочей книге почему то нет, скорее всего    
что то в структуре мешает, не понимаю что конкретно, я удалил всё не    
связанное с этим из книги и прикрепил файл к сообщению посмотрите, может  
вы поймете в чем дело. Гистограммы имеющиеся в книге если что можно удалить,  
они не так важны.
 
 
 
#17
24.01.2012 02:00:32
Мешает то, что там не везде есть УФ - добавляйте on error resume next
 
 
 
#18
24.01.2012 07:38:08
Попробуйте так:  
Sub perenos()  
   Dim i As Long  
   Application.ScreenUpdating = 0  
   On Error Resume Next  
   For i = 5 To Cells(Rows.Count, 7).End(xlUp).Row  
       If Cells(i, 7).FormatConditions.Count > 0 Then  
           If Cells(i, 7).Value < Range((Cells(i, 7).FormatConditions(1).IconCriteria(3).Value)).Value Then Cells(i, 4) = Cells(i, 8)  
       End If  
   Next  
   Application.ScreenUpdating = 1  
End Sub
 
 
 
#19
24.01.2012 20:25:20
{quote}{login=sva}{date=24.01.2012 07:38}{thema=}{post}Попробуйте так:  
Sub perenos()  
   Dim i As Long  
   Application.ScreenUpdating = 0  
   On Error Resume Next  
   For i = 5 To Cells(Rows.Count, 7).End(xlUp).Row  
       If Cells(i, 7).FormatConditions.Count > 0 Then  
           If Cells(i, 7).Value < Range((Cells(i, 7).FormatConditions(1).IconCriteria(3).Value)).Value Then Cells(i, 4) = Cells(i, 8)  
       End If  
   Next  
   Application.ScreenUpdating = 1  
End Sub{/post}{/quote}  
 
Всё заработало как надо, только единственное, я обратил внимание на строку 137  
значек есть а перенос не происходит я попробовал разобраться и нашел  
закономерность, все УФ в книге привязаны к столбцам AO и AP для того чтобы можно было подкорректировать настройку сразу в книге, так вот если количество  
на складе совпадает со столбцом AO "Среднее" то по чемуто макрос пропускает  
такую строку, не понято почему, а мне никак нельзя пропустить позицию при заказе.
 
 
 
#20
24.01.2012 21:55:20
Так будет правильно:  
Sub perenos()  
   Dim i As Long  
   Application.ScreenUpdating = 0  
   On Error Resume Next  
   For i = 5 To Cells(Rows.Count, 7).End(xlUp).Row  
       If Cells(i, 7).FormatConditions.Count > 0 Then  
           If Cells(i, 7).FormatConditions(1).IconCriteria(3).Operator = 5 Then  
               If Cells(i, 7).Value <= Range((Cells(i, 7).FormatConditions(1).IconCriteria(3).Value)).Value Then Cells(i, 4) = Cells(i, 8)  
           ElseIf Cells(i, 7).FormatConditions(1).IconCriteria(3).Operator = 7 Then  
               If Cells(i, 7).Value < Range((Cells(i, 7).FormatConditions(1).IconCriteria(3).Value)).Value Then Cells(i, 4) = Cells(i, 8)  
           End If  
       End If  
   Next  
   Application.ScreenUpdating = 1  
End Sub
 
 
 
#21
25.01.2012 00:43:16
{quote}{login=sva}{date=24.01.2012 09:55}{thema=}{post}Так будет правильно:  
Sub perenos()  
   Dim i As Long  
   Application.ScreenUpdating = 0  
   On Error Resume Next  
   For i = 5 To Cells(Rows.Count, 7).End(xlUp).Row  
       If Cells(i, 7).FormatConditions.Count > 0 Then  
           If Cells(i, 7).FormatConditions(1).IconCriteria(3).Operator = 5 Then  
               If Cells(i, 7).Value <= Range((Cells(i, 7).FormatConditions(1).IconCriteria(3).Value)).Value Then Cells(i, 4) = Cells(i, 8)  
           ElseIf Cells(i, 7).FormatConditions(1).IconCriteria(3).Operator = 7 Then  
               If Cells(i, 7).Value < Range((Cells(i, 7).FormatConditions(1).IconCriteria(3).Value)).Value Then Cells(i, 4) = Cells(i, 8)  
           End If  
       End If  
   Next  
   Application.ScreenUpdating = 1  
End Sub{/post}{/quote}  
 
Спасибо Вам!!! Все работает так как надо.
 
 
 
Страницы: 1
Читают тему
Наверх