Sub Макрос_1() Dim i& For i = 8 To 57 If Cells(i, "T") <> "" And (Cells(i, "V") < -2 Or Cells(i, "V") > 2) Then Cells(i, "V").Value = Cells(i, "V").Value Intersect(Rows(i), Range("T:t,AB:AC,AI:ai,AV:AX")).ClearContents End If If Cells(i, "U") <> "" And (Cells(i, "W") < -2 Or Cells(i, "W") > 2) Then Cells(i, "W").Value = Cells(i, "W").Value Intersect(Rows(i), Range("U:U,AL:AM,AS:as")).ClearContents End If Next End Sub
[/vba]Проверьте, а то у меня 2003-й кое-какие формулы не понимает.
Наверное по первому вопросу так. [vba]
Код
Sub Макрос_1() Dim i& For i = 8 To 57 If Cells(i, "T") <> "" And (Cells(i, "V") < -2 Or Cells(i, "V") > 2) Then Cells(i, "V").Value = Cells(i, "V").Value Intersect(Rows(i), Range("T:t,AB:AC,AI:ai,AV:AX")).ClearContents End If If Cells(i, "U") <> "" And (Cells(i, "W") < -2 Or Cells(i, "W") > 2) Then Cells(i, "W").Value = Cells(i, "W").Value Intersect(Rows(i), Range("U:U,AL:AM,AS:as")).ClearContents End If Next End Sub
[/vba]Проверьте, а то у меня 2003-й кое-какие формулы не понимает.Wasilich
Сообщение отредактировал Wasilich - Пятница, 01.04.2016, 14:15
Wasilich, а активация макроса №1 через кнопку. Мне нужно смотреть видео как создать данную кнопку чтоб ее установить или же в предложенном вами макросе он уже прописан???
Wasilich, а активация макроса №1 через кнопку. Мне нужно смотреть видео как создать данную кнопку чтоб ее установить или же в предложенном вами макросе он уже прописан???lebensvoll
После этого если оператор видит что условие не срабатывает: Цитата 1. AS60 значение будет <=1,5; 2. AU:AX61 значение будет >=0,7; 3. AH63:AK64 значение будет >6 <15; он начинает (я их окрашиваю в оранжевый цвет смотрю приближенные значения к (>2; <-2)
Офигеть, как Вы пишите. Я понял так. Нужно делать проверку значений в столбцах V и W каждый раз снижая контрольное значение до тех пор пока не будут соблюдены условия в ячейках AS60, AU61:AX61 и AH63:AK64 Так? Если так, с каким шагом снижать контрольное значение? >1,8 <-1,8 это шаг 0,2.
После этого если оператор видит что условие не срабатывает: Цитата 1. AS60 значение будет <=1,5; 2. AU:AX61 значение будет >=0,7; 3. AH63:AK64 значение будет >6 <15; он начинает (я их окрашиваю в оранжевый цвет смотрю приближенные значения к (>2; <-2)
Офигеть, как Вы пишите. Я понял так. Нужно делать проверку значений в столбцах V и W каждый раз снижая контрольное значение до тех пор пока не будут соблюдены условия в ячейках AS60, AU61:AX61 и AH63:AK64 Так? Если так, с каким шагом снижать контрольное значение? >1,8 <-1,8 это шаг 0,2.Wasilich
Wasilich, прошу прощение конечно но я с этим ни разу не сталкивался (((( да вы все правильно меня поняли спасибо вам огромное. Я очень надеюсь что с прописыванием второго макроса вы хоть немного поняли (что я написал) не кажется для вас это бредом!?
Wasilich, прошу прощение конечно но я с этим ни разу не сталкивался (((( да вы все правильно меня поняли спасибо вам огромное. Я очень надеюсь что с прописыванием второго макроса вы хоть немного поняли (что я написал) не кажется для вас это бредом!?lebensvoll
Далее макрос 2 должен провести следующую конструкцию проверки:
[vba]
Код
With thisworksheet if .range("AS60")<=1.5 and _ .range("AU61")>=0.7 and _ (.range("AU61")<=6 and .range("AU61")>=15) then ''' это было условие '1. если в ячейке AS60 значение >1,5; '2. также в ячейке AU:AX61 значение <0,7; '3. в ячейке AH63:AK64 значение <6 >15 'Если три этих пункта не выполняются end with
[/vba]
Цитата
Далее не ясна Ваша конструкция- "макрос теоретически произвел расчет и предположительно "окрасил" ячейки (предполагаемые) ". Макрос может или произвести расчет или не произвести- теоретически произвести его у меня не хватает фантазии как это интерпретировать. С окрашиванием - тоже самое. Поясните поконкретнее.
т.е он не может произвести окрашивание (да и ладно тогда) но удалить то он может если он произвел расчет
Wasilich, смотрите что говорит кросс
Цитата
выполняем макрос
[vba]
Код
Worksheet_Change(ByVal Target As Range)
[/vba]
Цитата
Далее макрос 2 должен провести следующую конструкцию проверки:
[vba]
Код
With thisworksheet if .range("AS60")<=1.5 and _ .range("AU61")>=0.7 and _ (.range("AU61")<=6 and .range("AU61")>=15) then ''' это было условие '1. если в ячейке AS60 значение >1,5; '2. также в ячейке AU:AX61 значение <0,7; '3. в ячейке AH63:AK64 значение <6 >15 'Если три этих пункта не выполняются end with
[/vba]
Цитата
Далее не ясна Ваша конструкция- "макрос теоретически произвел расчет и предположительно "окрасил" ячейки (предполагаемые) ". Макрос может или произвести расчет или не произвести- теоретически произвести его у меня не хватает фантазии как это интерпретировать. С окрашиванием - тоже самое. Поясните поконкретнее.
т.е он не может произвести окрашивание (да и ладно тогда) но удалить то он может если он произвел расчетlebensvoll
Wasilich, прошу прощение поспешил ответить на сообщение
Цитата
Дата: Пятница, 01.04.2016, 14:37 | Сообщение № 44
не нужно в столбце V производить проверку ((((( 2-й макрос лишь производит проверку в столбце W (((( простите отвлекли блин по работе
Цитата
Я понял так. Нужно делать проверку значений в столбцах V и W каждый раз снижая контрольное значение до тех пор пока не будут соблюдены условия в ячейках AS60, AU61:AX61 и AH63:AK64 Так? Если так, с каким шагом снижать контрольное значение? >1,8 <-1,8 это шаг 0,2.
Wasilich, прошу прощение поспешил ответить на сообщение
Цитата
Дата: Пятница, 01.04.2016, 14:37 | Сообщение № 44
не нужно в столбце V производить проверку ((((( 2-й макрос лишь производит проверку в столбце W (((( простите отвлекли блин по работе
Цитата
Я понял так. Нужно делать проверку значений в столбцах V и W каждый раз снижая контрольное значение до тех пор пока не будут соблюдены условия в ячейках AS60, AU61:AX61 и AH63:AK64 Так? Если так, с каким шагом снижать контрольное значение? >1,8 <-1,8 это шаг 0,2.
Wasilich, смотрите возможно так вам будет проще понять макрос №2 должен определить в столбце W приблеженные значения к (>2; <-2) окрасить их, а в столбце X прописать "отбраковывается" и удалить значения
Цитата
из ячеек: U; AL:AM; AS; AV:AX. Но, при этом значения в столбце "W" не изменилось после удаления
но при этом сохранить исходное значение которое получилось в столбце W (т.е. оставить его не измененным, потому как если удалить значения из указанных выше столбцах то значение в столбце "W" меняется ((( ). тем самым он должен столько раз произвести это чтоб условие в ячейках сработало
Цитата
1. AS60 значение будет <=1,5; 2. AU:AX61 значение будет >=0,7; 3. AH63:AK64 значение будет >6 <15;
Wasilich, смотрите возможно так вам будет проще понять макрос №2 должен определить в столбце W приблеженные значения к (>2; <-2) окрасить их, а в столбце X прописать "отбраковывается" и удалить значения
Цитата
из ячеек: U; AL:AM; AS; AV:AX. Но, при этом значения в столбце "W" не изменилось после удаления
но при этом сохранить исходное значение которое получилось в столбце W (т.е. оставить его не измененным, потому как если удалить значения из указанных выше столбцах то значение в столбце "W" меняется ((( ). тем самым он должен столько раз произвести это чтоб условие в ячейках сработало
Цитата
1. AS60 значение будет <=1,5; 2. AU:AX61 значение будет >=0,7; 3. AH63:AK64 значение будет >6 <15;
Ну что сказать, бред не в самой задаче, а в том как вы ее преподносили. Три страницы не нужной информации, и только в последних постах выжимая из Вас нужную, что то прояснилось. Проверяйте. Теоретически должно работать. Практически проверить сложно. У меня проблема с функцией _xlfn.IFERROR()
Ну что сказать, бред не в самой задаче, а в том как вы ее преподносили. Три страницы не нужной информации, и только в последних постах выжимая из Вас нужную, что то прояснилось. Проверяйте. Теоретически должно работать. Практически проверить сложно. У меня проблема с функцией _xlfn.IFERROR()Wasilich
Три страницы не нужной информации, и только в последних постах выжимая из Вас нужную, что то прояснилось.
вот самое что интересное я все это сразу и излагал ((((. В приложенном файле вы объеденили кнопку макроса )))) что тоже интересно и толково. НО условие не выполнилось и удалились все оставшиеся значения (и вы поняли правильно удалялись то что нужно) несколько раз макрос предложил удалить очередные значения (((( и так все они и удалились.
Wasilich,
Цитата
Три страницы не нужной информации, и только в последних постах выжимая из Вас нужную, что то прояснилось.
вот самое что интересное я все это сразу и излагал ((((. В приложенном файле вы объеденили кнопку макроса )))) что тоже интересно и толково. НО условие не выполнилось и удалились все оставшиеся значения (и вы поняли правильно удалялись то что нужно) несколько раз макрос предложил удалить очередные значения (((( и так все они и удалились.lebensvoll
Sub Макрос_2() Dim x&, j&, M@, B@ M = -1.9 B = 1.9 For x = 1 To 20 For j = 8 To 57 If Cells(j, "U") <> "" And (Cells(j, "W") < M Or Cells(j, "W") > <img rel="usm" src="http://www.excelworld.ru/sml2/cool.gif" border="0" align="absmiddle" alt="B)" /> Then Cells(j, "W").Value = Cells(j, "W").Value Cells(j, "W").Interior.ColorIndex = 36 Cells(j, "X") = "Отбраковывается" Cells(j, "X").Interior.ColorIndex = 36 Intersect(Rows(j), Range("U:U,AL:AM,AS:as")).ClearContents End If Next j If Range("AS60") <= 1.5 And Range("AU61") >= 0.7 And (Range("AU61") <= 6 And Range("AU61") >= 15) Then MsgBox "Условие выполнено, процедура закончена" Exit Sub Else If MsgBox("Условие не выполнено. Продолжить?", vbYesNo) = 6 Then M = M + 0.1 B = B - 0.1 Cells(3, "V") = M Cells(3, "W") = B Else Cells(3, "V") = "" Cells(3, "W") = "" Exit Sub End If End If Next x End Sub
'1. Если в ячейке V14 значение (">2;>-2") 'УДАЛЯЛИСЬ значения из ячеек: T14; AB:AC14; AI14; AV:AX14.
'2. Если в ячейке W14 значение (">2;>-2") 'УДАЛИЛИСЬ значения из ячеек: U14; AL:AM14; AS14
'макрос №2 'должен определить в столбце W приблеженные значения к (>2; <-2) 'окрасить их, а в столбце X прописать "отбраковывается" 'и удалить значения из ячеек: U; AL:AM; AS; AV:AX. 'Но, при этом значения в столбце "W" не изменилось после удаления
[/vba] во втором макросе есть что не так я понимаю. Почему когда я удалял так в ручную условие выполнялось а когда с макросом (((( нет
[vba]
Код
Sub Макрос_2() Dim x&, j&, M@, B@ M = -1.9 B = 1.9 For x = 1 To 20 For j = 8 To 57 If Cells(j, "U") <> "" And (Cells(j, "W") < M Or Cells(j, "W") > <img rel="usm" src="http://www.excelworld.ru/sml2/cool.gif" border="0" align="absmiddle" alt="B)" /> Then Cells(j, "W").Value = Cells(j, "W").Value Cells(j, "W").Interior.ColorIndex = 36 Cells(j, "X") = "Отбраковывается" Cells(j, "X").Interior.ColorIndex = 36 Intersect(Rows(j), Range("U:U,AL:AM,AS:as")).ClearContents End If Next j If Range("AS60") <= 1.5 And Range("AU61") >= 0.7 And (Range("AU61") <= 6 And Range("AU61") >= 15) Then MsgBox "Условие выполнено, процедура закончена" Exit Sub Else If MsgBox("Условие не выполнено. Продолжить?", vbYesNo) = 6 Then M = M + 0.1 B = B - 0.1 Cells(3, "V") = M Cells(3, "W") = B Else Cells(3, "V") = "" Cells(3, "W") = "" Exit Sub End If End If Next x End Sub
'1. Если в ячейке V14 значение (">2;>-2") 'УДАЛЯЛИСЬ значения из ячеек: T14; AB:AC14; AI14; AV:AX14.
'2. Если в ячейке W14 значение (">2;>-2") 'УДАЛИЛИСЬ значения из ячеек: U14; AL:AM14; AS14
'макрос №2 'должен определить в столбце W приблеженные значения к (>2; <-2) 'окрасить их, а в столбце X прописать "отбраковывается" 'и удалить значения из ячеек: U; AL:AM; AS; AV:AX. 'Но, при этом значения в столбце "W" не изменилось после удаления
[/vba] во втором макросе есть что не так я понимаю. Почему когда я удалял так в ручную условие выполнялось а когда с макросом (((( нетlebensvoll
If Cells(j, "U") <> "" And (Cells(j, "W") < M Or Cells(j, "W") > <img rel="usm" src="http://www.excelworld.ru/sml2/cool.gif" border="0" align="absmiddle" alt="B)" /> Then
смогли добавить какую то не понятную ахинею. Извините я "умываю руки". Успехов.
If Cells(j, "U") <> "" And (Cells(j, "W") < M Or Cells(j, "W") > <img rel="usm" src="http://www.excelworld.ru/sml2/cool.gif" border="0" align="absmiddle" alt="B)" /> Then
смогли добавить какую то не понятную ахинею. Извините я "умываю руки". Успехов.Wasilich
Sub Макрос_1() Dim i& For i = 8 To 57 If Cells(i, "T") <> "" And (Cells(i, "V") < -2 Or Cells(i, "V") > 2) Then Cells(i, "V").Value = Cells(i, "V").Value Cells(i, "V").Interior.ColorIndex = 36 Cells(i, "X") = "Отбраковывается" Cells(i, "X").Interior.ColorIndex = 36 Intersect(Rows(i), Range("T:t,AB:AC,AI:ai,AV:AX")).ClearContents End If If Cells(i, "U") <> "" And (Cells(i, "W") < -2 Or Cells(i, "W") > 2) Then Cells(i, "W").Value = Cells(i, "W").Value Cells(i, "W").Interior.ColorIndex = 36 Cells(i, "X") = "Отбраковывается" Cells(i, "X").Interior.ColorIndex = 36 Intersect(Rows(i), Range("U:U,AL:AM,AS:as")).ClearContents End If Next If Range("AS60") <= 1.5 And Range("AU61") >= 0.7 And (Range("AU61") <= 6 And Range("AU61") >= 15) Then MsgBox "Условие выполнено, процедура закончена" Exit Sub Else If MsgBox("Условие не выполнено. Продолжить?", vbYesNo) = 6 Then Макрос_2 End If End If End Sub Sub Макрос_2() Dim x&, j&, M@, B@ M = -1.9 B = 1.9 For x = 1 To 20 For j = 8 To 57 If Cells(j, "U") <> "" And (Cells(j, "W") < M Or Cells(j, "W") > <img rel="usm" src="http://www.excelworld.ru/sml2/cool.gif" border="0" align="absmiddle" alt="B)" /> Then Cells(j, "W").Value = Cells(j, "W").Value Cells(j, "W").Interior.ColorIndex = 36 Cells(j, "X") = "Отбраковывается" Cells(j, "X").Interior.ColorIndex = 36 Intersect(Rows(j), Range("U:U,AL:AM,AS:as,AV:AX")).ClearContents End If Next j If Range("AS60") <= 1.5 And Range("AU61") >= 0.7 And (Range("AU61") <= 6 And Range("AU61") >= 15) Then MsgBox "Условие выполнено, процедура закончена" Exit Sub Else If MsgBox("Условие не выполнено. Продолжить?", vbYesNo) = 6 Then M = M + 0.1 B = B - 0.1 Cells(3, "V") = M Cells(3, "W") = B Else Cells(3, "V") = "" Cells(3, "W") = "" Exit Sub End If End If Next x End Sub
'1. Если в ячейке V14 значение (">2;>-2") 'УДАЛЯЛИСЬ значения из ячеек: T14; AB:AC14; AI14; AV:AX14.
'2. Если в ячейке W14 значение (">2;>-2") 'УДАЛИЛИСЬ значения из ячеек: U14; AL:AM14; AS14
'макрос №2 'должен определить в столбце W приблеженные значения к (>2; <-2) 'окрасить их, а в столбце X прописать "отбраковывается" 'и удалить значения из ячеек: U; AL:AM; AS; AV:AX. 'Но, при этом значения в столбце "W" не изменилось после удаления
[/vba] Просто этот бред приписывается (((( не отпускайте руки (((( помогите завершить начатое. Внес столбцы и при использовании макроса наблюдаю как удаляются значения. Также смотрю за условием и вот оно удовлетворило но макрос продолжает прописывать что условие не выполнено (((((( Вы же все правильно прописали и верно
Wasilich, я так и сделал но [img][/img] [vba]
Код
Sub Макрос_1() Dim i& For i = 8 To 57 If Cells(i, "T") <> "" And (Cells(i, "V") < -2 Or Cells(i, "V") > 2) Then Cells(i, "V").Value = Cells(i, "V").Value Cells(i, "V").Interior.ColorIndex = 36 Cells(i, "X") = "Отбраковывается" Cells(i, "X").Interior.ColorIndex = 36 Intersect(Rows(i), Range("T:t,AB:AC,AI:ai,AV:AX")).ClearContents End If If Cells(i, "U") <> "" And (Cells(i, "W") < -2 Or Cells(i, "W") > 2) Then Cells(i, "W").Value = Cells(i, "W").Value Cells(i, "W").Interior.ColorIndex = 36 Cells(i, "X") = "Отбраковывается" Cells(i, "X").Interior.ColorIndex = 36 Intersect(Rows(i), Range("U:U,AL:AM,AS:as")).ClearContents End If Next If Range("AS60") <= 1.5 And Range("AU61") >= 0.7 And (Range("AU61") <= 6 And Range("AU61") >= 15) Then MsgBox "Условие выполнено, процедура закончена" Exit Sub Else If MsgBox("Условие не выполнено. Продолжить?", vbYesNo) = 6 Then Макрос_2 End If End If End Sub Sub Макрос_2() Dim x&, j&, M@, B@ M = -1.9 B = 1.9 For x = 1 To 20 For j = 8 To 57 If Cells(j, "U") <> "" And (Cells(j, "W") < M Or Cells(j, "W") > <img rel="usm" src="http://www.excelworld.ru/sml2/cool.gif" border="0" align="absmiddle" alt="B)" /> Then Cells(j, "W").Value = Cells(j, "W").Value Cells(j, "W").Interior.ColorIndex = 36 Cells(j, "X") = "Отбраковывается" Cells(j, "X").Interior.ColorIndex = 36 Intersect(Rows(j), Range("U:U,AL:AM,AS:as,AV:AX")).ClearContents End If Next j If Range("AS60") <= 1.5 And Range("AU61") >= 0.7 And (Range("AU61") <= 6 And Range("AU61") >= 15) Then MsgBox "Условие выполнено, процедура закончена" Exit Sub Else If MsgBox("Условие не выполнено. Продолжить?", vbYesNo) = 6 Then M = M + 0.1 B = B - 0.1 Cells(3, "V") = M Cells(3, "W") = B Else Cells(3, "V") = "" Cells(3, "W") = "" Exit Sub End If End If Next x End Sub
'1. Если в ячейке V14 значение (">2;>-2") 'УДАЛЯЛИСЬ значения из ячеек: T14; AB:AC14; AI14; AV:AX14.
'2. Если в ячейке W14 значение (">2;>-2") 'УДАЛИЛИСЬ значения из ячеек: U14; AL:AM14; AS14
'макрос №2 'должен определить в столбце W приблеженные значения к (>2; <-2) 'окрасить их, а в столбце X прописать "отбраковывается" 'и удалить значения из ячеек: U; AL:AM; AS; AV:AX. 'Но, при этом значения в столбце "W" не изменилось после удаления
[/vba] Просто этот бред приписывается (((( не отпускайте руки (((( помогите завершить начатое. Внес столбцы и при использовании макроса наблюдаю как удаляются значения. Также смотрю за условием и вот оно удовлетворило но макрос продолжает прописывать что условие не выполнено (((((( Вы же все правильно прописали и верноlebensvoll
Кто бы ты ни был, мир в твоих руках
Сообщение отредактировал lebensvoll - Пятница, 01.04.2016, 23:42
If Cells(j, "U") <> "" And (Cells(j, "W") < M Or Cells(j, "W") > <img rel="usm" src="http://www.excelworld.ru/sml2/cool.gif" border="0" align="absmiddle" alt="B)" /> Then
Тут "lol.gif" больше подходит, чем "сооl", думаю. Значение в ячейке листа, нельзя со смайликом в посте форума, сравнивать, - " Mismatch Типо" [offtop]Чёт Василич накосячил, видимо.) или просто, - "Первый апрель"?
If Cells(j, "U") <> "" And (Cells(j, "W") < M Or Cells(j, "W") > <img rel="usm" src="http://www.excelworld.ru/sml2/cool.gif" border="0" align="absmiddle" alt="B)" /> Then
Тут "lol.gif" больше подходит, чем "сооl", думаю. Значение в ячейке листа, нельзя со смайликом в посте форума, сравнивать, - " Mismatch Типо" [offtop]Чёт Василич накосячил, видимо.) или просто, - "Первый апрель"?al-Ex
Сообщение отредактировал al-Ex - Суббота, 02.04.2016, 01:08
Sub Макрос_1() Dim i& For i = 8 To 57 If Cells(i, "T") <> "" And (Cells(i, "V") < -2 Or Cells(i, "V") > 2) Then Cells(i, "V").Value = Cells(i, "V").Value Cells(i, "V").Interior.ColorIndex = 36 Cells(i, "X") = "Отбраковывается" Cells(i, "X").Interior.ColorIndex = 36 Intersect(Rows(i), Range("T:t,AB:AC,AI:ai,AV:AX")).ClearContents End If If Cells(i, "U") <> "" And (Cells(i, "W") < -2 Or Cells(i, "W") > 2) Then Cells(i, "W").Value = Cells(i, "W").Value Cells(i, "W").Interior.ColorIndex = 36 Cells(i, "X") = "Отбраковывается" Cells(i, "X").Interior.ColorIndex = 36 Intersect(Rows(i), Range("U:U,AL:AM,AS:as,AV:AX")).ClearContents End If Next If Range("AS60") <= 1.5 And Range("AU61") >= 0.7 And (Range("AH63") >= 6 And Range("AH63") <= 15) Then MsgBox "Условие выполнено, процедура закончена" Exit Sub Else If MsgBox("Условие не выполнено. Продолжить?", vbYesNo) = 6 Then Макрос_2 End If End If End Sub
[/vba] макрос №2 [vba]
Код
Sub Макрос_2() Dim x&, j&, M@, B@ M = -1.9 B = 1.9 For x = 1 To 20 For j = 8 To 57 If Cells(j, "U") <> "" And (Cells(j, "W") < M Or Cells(j, "W") > <img rel="usm" src="http://www.excelworld.ru/sml2/cool.gif" border="0" align="absmiddle" alt="B)" /> Then Cells(j, "W").Value = Cells(j, "W").Value Cells(j, "W").Interior.ColorIndex = 36 Cells(j, "X") = "Отбраковывается" Cells(j, "X").Interior.ColorIndex = 36 Intersect(Rows(j), Range("U:U,AL:AM,AS:as,AV:AX")).ClearContents End If Next j If Range("AS60") <= 1.5 And Range("AU61") >= 0.7 And (Range("AH63") >= 6 And Range("AH63") <= 15) Then MsgBox "Условие выполнено, процедура закончена" Exit Sub Else If MsgBox("Условие не выполнено. Продолжить?", vbYesNo) = 6 Then M = M + 0.1 B = B - 0.1 Cells(3, "V") = M Cells(3, "W") = B Else Cells(3, "V") = "" Cells(3, "W") = "" Exit Sub End If End If Next x End Sub
'1. Если в ячейке V14 значение (">2;>-2") 'УДАЛЯЛИСЬ значения из ячеек: T14; AB:AC14; AI14; AV:AX14.
'2. Если в ячейке W14 значение (">2;>-2") 'УДАЛИЛИСЬ значения из ячеек: U14; AL:AM14; AS14
'макрос №2 'должен определить в столбце W приблеженные значения к (>2; <-2) 'окрасить их, а в столбце X прописать "отбраковывается" 'и удалить значения из ячеек: U; AL:AM; AS; AV:AX. 'Но, при этом значения в столбце "W" не изменилось после удаления
[/vba] ВЫ ПРОСТО ГЕНИЙ!!!! СПАСИБО ВАМ ОГРОМНОЕ ЗА ПОНИМАНИЕ ЖЕЛЕЗНОЕ ТЕРПЕНИЕ И ВЫДЕРЖКУ :hands: :hands:
Wasilich, макрос №1 [vba]
Код
Sub Макрос_1() Dim i& For i = 8 To 57 If Cells(i, "T") <> "" And (Cells(i, "V") < -2 Or Cells(i, "V") > 2) Then Cells(i, "V").Value = Cells(i, "V").Value Cells(i, "V").Interior.ColorIndex = 36 Cells(i, "X") = "Отбраковывается" Cells(i, "X").Interior.ColorIndex = 36 Intersect(Rows(i), Range("T:t,AB:AC,AI:ai,AV:AX")).ClearContents End If If Cells(i, "U") <> "" And (Cells(i, "W") < -2 Or Cells(i, "W") > 2) Then Cells(i, "W").Value = Cells(i, "W").Value Cells(i, "W").Interior.ColorIndex = 36 Cells(i, "X") = "Отбраковывается" Cells(i, "X").Interior.ColorIndex = 36 Intersect(Rows(i), Range("U:U,AL:AM,AS:as,AV:AX")).ClearContents End If Next If Range("AS60") <= 1.5 And Range("AU61") >= 0.7 And (Range("AH63") >= 6 And Range("AH63") <= 15) Then MsgBox "Условие выполнено, процедура закончена" Exit Sub Else If MsgBox("Условие не выполнено. Продолжить?", vbYesNo) = 6 Then Макрос_2 End If End If End Sub
[/vba] макрос №2 [vba]
Код
Sub Макрос_2() Dim x&, j&, M@, B@ M = -1.9 B = 1.9 For x = 1 To 20 For j = 8 To 57 If Cells(j, "U") <> "" And (Cells(j, "W") < M Or Cells(j, "W") > <img rel="usm" src="http://www.excelworld.ru/sml2/cool.gif" border="0" align="absmiddle" alt="B)" /> Then Cells(j, "W").Value = Cells(j, "W").Value Cells(j, "W").Interior.ColorIndex = 36 Cells(j, "X") = "Отбраковывается" Cells(j, "X").Interior.ColorIndex = 36 Intersect(Rows(j), Range("U:U,AL:AM,AS:as,AV:AX")).ClearContents End If Next j If Range("AS60") <= 1.5 And Range("AU61") >= 0.7 And (Range("AH63") >= 6 And Range("AH63") <= 15) Then MsgBox "Условие выполнено, процедура закончена" Exit Sub Else If MsgBox("Условие не выполнено. Продолжить?", vbYesNo) = 6 Then M = M + 0.1 B = B - 0.1 Cells(3, "V") = M Cells(3, "W") = B Else Cells(3, "V") = "" Cells(3, "W") = "" Exit Sub End If End If Next x End Sub
'1. Если в ячейке V14 значение (">2;>-2") 'УДАЛЯЛИСЬ значения из ячеек: T14; AB:AC14; AI14; AV:AX14.
'2. Если в ячейке W14 значение (">2;>-2") 'УДАЛИЛИСЬ значения из ячеек: U14; AL:AM14; AS14
'макрос №2 'должен определить в столбце W приблеженные значения к (>2; <-2) 'окрасить их, а в столбце X прописать "отбраковывается" 'и удалить значения из ячеек: U; AL:AM; AS; AV:AX. 'Но, при этом значения в столбце "W" не изменилось после удаления
[/vba] ВЫ ПРОСТО ГЕНИЙ!!!! СПАСИБО ВАМ ОГРОМНОЕ ЗА ПОНИМАНИЕ ЖЕЛЕЗНОЕ ТЕРПЕНИЕ И ВЫДЕРЖКУ :hands: :hands:lebensvoll
Кто бы ты ни был, мир в твоих руках
Сообщение отредактировал lebensvoll - Суббота, 02.04.2016, 19:36