Ещё мысль, кстати, и очевидная ошибка, которой почему-то никто не заметил: [vba]
Код
Sub Worksheet_Change() Sheets("Задания").Activate If ActiveCell.Column = 5 And InStr(1,lcase(ActiveCell.Value), "вып",vbtextcompare) Then With Sheets("Архив") Rows(ActiveCell.Row).Copy Destination:=.Rows(.Cells(Rows.Count,1).End(xlUp).row + 1) end with Rows(ActiveCell.Row).Delete End If End Sub
[/vba]
Ещё мысль, кстати, и очевидная ошибка, которой почему-то никто не заметил: [vba]
Код
Sub Worksheet_Change() Sheets("Задания").Activate If ActiveCell.Column = 5 And InStr(1,lcase(ActiveCell.Value), "вып",vbtextcompare) Then With Sheets("Архив") Rows(ActiveCell.Row).Copy Destination:=.Rows(.Cells(Rows.Count,1).End(xlUp).row + 1) end with Rows(ActiveCell.Row).Delete End If End Sub
Sub Worksheet_Change() Worksheets("Задания").Activate If ActiveCell.Column = 5 And InStr(1, UCase(ActiveCell.Value), "вып", vbTextCompare) > 0 Then With Sheets("Архив") Rows(ActiveCell.Row).Copy Destination:=.Rows(.Cells(Rows.Count, 1).End(xlUp).Row + 1) End With Rows(ActiveCell.Row).Delete End If End Sub
[/vba]
УМВР. [vba]
Код
Sub Worksheet_Change() Worksheets("Задания").Activate If ActiveCell.Column = 5 And InStr(1, UCase(ActiveCell.Value), "вып", vbTextCompare) > 0 Then With Sheets("Архив") Rows(ActiveCell.Row).Copy Destination:=.Rows(.Cells(Rows.Count, 1).End(xlUp).Row + 1) End With Rows(ActiveCell.Row).Delete End If End Sub
Исходник в самом начале выкладывал. В нем автоматически сносится строка при занесении в 5 столбец слова "выполнено". Хотелось бы подправить код чтобы с кнопки срабатывал перенос строк.
Исходник в самом начале выкладывал. В нем автоматически сносится строка при занесении в 5 столбец слова "выполнено". Хотелось бы подправить код чтобы с кнопки срабатывал перенос строк.Anis625
Вы мой файл гоняли? Не забыли, что активна должна быть ячейка в колонке Е, содержащая "вып"? Мой, разумеется, отрабатывает один раз и вызова у него нет.
Вы мой файл гоняли? Не забыли, что активна должна быть ячейка в колонке Е, содержащая "вып"? Мой, разумеется, отрабатывает один раз и вызова у него нет.StoTisteg
Интуитивно понятный код - это когда интуитивно понятно, что это код.
Вы мой файл гоняли? Не забыли, что активна должна быть ячейка в колонке Е, содержащая "вып"? Мой, разумеется, отрабатывает один раз и вызова у него нет.
Добрый день. В эти дни компа под руками не было. Я похоже не правильно тестил. Поставил кнопку на макрос. Встаю на ячейку. Нажимаю. Все работает =) Почти то что нужно. Бывает, что выполненных строк много больше чем 1 строка. Не совсем удобно по одной переносить. Можно как-нибудь сделать чтобы все строки сразу переносились?
Вы мой файл гоняли? Не забыли, что активна должна быть ячейка в колонке Е, содержащая "вып"? Мой, разумеется, отрабатывает один раз и вызова у него нет.
Добрый день. В эти дни компа под руками не было. Я похоже не правильно тестил. Поставил кнопку на макрос. Встаю на ячейку. Нажимаю. Все работает =) Почти то что нужно. Бывает, что выполненных строк много больше чем 1 строка. Не совсем удобно по одной переносить. Можно как-нибудь сделать чтобы все строки сразу переносились?Anis625
Worksheets("Задания").Activate rw=2 Loop Until Cells(rw,1).Value="" If InStr(1, UCase(Cells(rw,5).Value), "вып", vbTextCompare) > 0 Then With Sheets("Архив") Rows(rw).Copy Destination:=.Rows(.Cells(Rows.Count, 1).End(xlUp).Row + 1) End With Rows(rw).Delete Else: rw=rw+1 End If End Sub
[/vba] Здесь предполагается, что: 1) первая строка таблицы — заголовок. Если заголовка нет, нужно вместо [vba]
Код
rw=2
[/vba] писать [vba]
Код
rw=1
[/vba] Если заголовок больше одной строки — rw соответственно первая строка после заголовка. 2) первая колонка всегда заполнена. Если это не так, в [vba]
Код
Loop Until Cells(rw,1).Value=""
[/vba] вместо 1 подставить номер гарантированно заполненной колонки.
[vba]
Код
Sub Worksheet_Change()
Dim rw As Long
Worksheets("Задания").Activate rw=2 Loop Until Cells(rw,1).Value="" If InStr(1, UCase(Cells(rw,5).Value), "вып", vbTextCompare) > 0 Then With Sheets("Архив") Rows(rw).Copy Destination:=.Rows(.Cells(Rows.Count, 1).End(xlUp).Row + 1) End With Rows(rw).Delete Else: rw=rw+1 End If End Sub
[/vba] Здесь предполагается, что: 1) первая строка таблицы — заголовок. Если заголовка нет, нужно вместо [vba]
Код
rw=2
[/vba] писать [vba]
Код
rw=1
[/vba] Если заголовок больше одной строки — rw соответственно первая строка после заголовка. 2) первая колонка всегда заполнена. Если это не так, в [vba]
Код
Loop Until Cells(rw,1).Value=""
[/vba] вместо 1 подставить номер гарантированно заполненной колонки.StoTisteg
Интуитивно понятный код - это когда интуитивно понятно, что это код.
Worksheets("Задания").Activate rw=2 Loop Until Cells(rw,1).Value="" If InStr(1, UCase(Cells(rw,5).Value), "вып", vbTextCompare) > 0 Then With Sheets("Архив") Rows(rw).Copy Destination:=.Rows(.Cells(Rows.Count, 1).End(xlUp).Row + 1) End With Rows(rw).Delete Else: rw=rw+1 End If End Sub
Ругается код на строку Loop Until. Все проверил: шапка таблицы 1-я строка, первая колонка заполнена (да и все заполнены, кроме 5-ой)
Worksheets("Задания").Activate rw=2 Loop Until Cells(rw,1).Value="" If InStr(1, UCase(Cells(rw,5).Value), "вып", vbTextCompare) > 0 Then With Sheets("Архив") Rows(rw).Copy Destination:=.Rows(.Cells(Rows.Count, 1).End(xlUp).Row + 1) End With Rows(rw).Delete Else: rw=rw+1 End If End Sub
Ругается код на строку Loop Until. Все проверил: шапка таблицы 1-я строка, первая колонка заполнена (да и все заполнены, кроме 5-ой)Anis625
Worksheets("Задания").Activate rw=2 Do Until Cells(rw,1).Value="" If InStr(1, UCase(Cells(rw,5).Value), "вып", vbTextCompare) > 0 Then With Sheets("Архив") Rows(rw).Copy Destination:=.Rows(.Cells(Rows.Count, 1).End(xlUp).Row + 1) End With Rows(rw).Delete Else: rw=rw+1 End If Loop End Sub
[/vba]
Совсем плохой стал...[vba]
Код
Sub Worksheet_Change()
Dim rw As Long
Worksheets("Задания").Activate rw=2 Do Until Cells(rw,1).Value="" If InStr(1, UCase(Cells(rw,5).Value), "вып", vbTextCompare) > 0 Then With Sheets("Архив") Rows(rw).Copy Destination:=.Rows(.Cells(Rows.Count, 1).End(xlUp).Row + 1) End With Rows(rw).Delete Else: rw=rw+1 End If Loop End Sub
Такой вариант не подходит. Это колонка творческая. Там все что угодно может быть. Но самое главное слово "выполнено" и все производные должны сноситься в архив. Не выполнено - думаю вряд ли появится.
Такой вариант не подходит. Это колонка творческая. Там все что угодно может быть. Но самое главное слово "выполнено" и все производные должны сноситься в архив. Не выполнено - думаю вряд ли появится.Anis625
Worksheets("Задания").Activate rw=2 Do Until Cells(rw,1).Value="" If InStr(1, UCase(Cells(rw,5).Value), "вып", vbTextCompare) > 0 and InStr(1, UCase(Cells(rw,5).Value), "не вып", vbTextCompare)=0 Then With Sheets("Архив") Rows(rw).Copy Destination:=.Rows(.Cells(Rows.Count, 1).End(xlUp).Row + 1) End With Rows(rw).Delete Else: rw=rw+1 End If Loop End Sub
Worksheets("Задания").Activate rw=2 Do Until Cells(rw,1).Value="" If InStr(1, UCase(Cells(rw,5).Value), "вып", vbTextCompare) > 0 and InStr(1, UCase(Cells(rw,5).Value), "не вып", vbTextCompare)=0 Then With Sheets("Архив") Rows(rw).Copy Destination:=.Rows(.Cells(Rows.Count, 1).End(xlUp).Row + 1) End With Rows(rw).Delete Else: rw=rw+1 End If Loop End Sub
Подскажите, пожалуйста. Отлично использовал ваш макрос. После 30 строки макрос не срабатывет. То есть, слово "архив" в тексте есть (заменил слово "вып" на "архив"), а его не переносит в лист Архив.
В чем может быть загвостка?
StoTisteg, приветствую.
Подскажите, пожалуйста. Отлично использовал ваш макрос. После 30 строки макрос не срабатывет. То есть, слово "архив" в тексте есть (заменил слово "вып" на "архив"), а его не переносит в лист Архив.