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

Вход

Регистрация

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

 

= Мир MS Excel/Перенос строк по условию - Страница 2 - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 2 из 3
  • «
  • 1
  • 2
  • 3
  • »
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос строк по условию (Макросы/Sub)
Перенос строк по условию
Anis625 Дата: Суббота, 28.04.2018, 16:03 | Сообщение № 21
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Тогда колитесь, что именно пишет.


Вообще ничего не происходит =)

И с новым кодом тоже =(
 
Ответить
Сообщение
Тогда колитесь, что именно пишет.


Вообще ничего не происходит =)

И с новым кодом тоже =(

Автор - Anis625
Дата добавления - 28.04.2018 в 16:03
StoTisteg Дата: Суббота, 28.04.2018, 16:20 | Сообщение № 22
Группа: Авторы
Ранг: Старожил
Сообщений: 1017
Репутация: 86 ±
Замечаний: 0% ±

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


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеПопробуйте пошагово прогнать и посмотреть, где спотыкается. И скиньте, плз, файл с макросом, который гоняете.

Автор - StoTisteg
Дата добавления - 28.04.2018 в 16:20
StoTisteg Дата: Суббота, 28.04.2018, 16:26 | Сообщение № 23
Группа: Авторы
Ранг: Старожил
Сообщений: 1017
Репутация: 86 ±
Замечаний: 0% ±

Excel 2010
Ещё мысль, кстати, и очевидная ошибка, которой почему-то никто не заметил:
[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
[/vba]

Автор - StoTisteg
Дата добавления - 28.04.2018 в 16:26
StoTisteg Дата: Суббота, 28.04.2018, 16:41 | Сообщение № 24
Группа: Авторы
Ранг: Старожил
Сообщений: 1017
Репутация: 86 ±
Замечаний: 0% ±

Excel 2010
УМВР.
[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
[/vba]
К сообщению приложен файл: __.xlsm(15.1 Kb)


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеУМВР.
[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
[/vba]

Автор - StoTisteg
Дата добавления - 28.04.2018 в 16:41
Anis625 Дата: Суббота, 28.04.2018, 16:52 | Сообщение № 25
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
И скиньте, плз, файл с макросом, который гоняете.


Исходник в самом начале выкладывал. В нем автоматически сносится строка при занесении в 5 столбец слова "выполнено".
Хотелось бы подправить код чтобы с кнопки срабатывал перенос строк.
 
Ответить
Сообщение
И скиньте, плз, файл с макросом, который гоняете.


Исходник в самом начале выкладывал. В нем автоматически сносится строка при занесении в 5 столбец слова "выполнено".
Хотелось бы подправить код чтобы с кнопки срабатывал перенос строк.

Автор - Anis625
Дата добавления - 28.04.2018 в 16:52
Anis625 Дата: Суббота, 28.04.2018, 16:53 | Сообщение № 26
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
УМВР.

Никаких изменений. Не сносит строки =(
 
Ответить
Сообщение
УМВР.

Никаких изменений. Не сносит строки =(

Автор - Anis625
Дата добавления - 28.04.2018 в 16:53
StoTisteg Дата: Суббота, 28.04.2018, 23:39 | Сообщение № 27
Группа: Авторы
Ранг: Старожил
Сообщений: 1017
Репутация: 86 ±
Замечаний: 0% ±

Excel 2010
Вы мой файл гоняли? Не забыли, что активна должна быть ячейка в колонке Е, содержащая "вып"? Мой, разумеется, отрабатывает один раз и вызова у него нет.


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеВы мой файл гоняли? Не забыли, что активна должна быть ячейка в колонке Е, содержащая "вып"? Мой, разумеется, отрабатывает один раз и вызова у него нет.

Автор - StoTisteg
Дата добавления - 28.04.2018 в 23:39
Anis625 Дата: Четверг, 03.05.2018, 07:52 | Сообщение № 28
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Вы мой файл гоняли? Не забыли, что активна должна быть ячейка в колонке Е, содержащая "вып"? Мой, разумеется, отрабатывает один раз и вызова у него нет.

Добрый день. В эти дни компа под руками не было.
Я похоже не правильно тестил.
Поставил кнопку на макрос. Встаю на ячейку. Нажимаю. Все работает =)
Почти то что нужно. Бывает, что выполненных строк много больше чем 1 строка. Не совсем удобно по одной переносить.
Можно как-нибудь сделать чтобы все строки сразу переносились?
 
Ответить
Сообщение
Вы мой файл гоняли? Не забыли, что активна должна быть ячейка в колонке Е, содержащая "вып"? Мой, разумеется, отрабатывает один раз и вызова у него нет.

Добрый день. В эти дни компа под руками не было.
Я похоже не правильно тестил.
Поставил кнопку на макрос. Встаю на ячейку. Нажимаю. Все работает =)
Почти то что нужно. Бывает, что выполненных строк много больше чем 1 строка. Не совсем удобно по одной переносить.
Можно как-нибудь сделать чтобы все строки сразу переносились?

Автор - Anis625
Дата добавления - 03.05.2018 в 07:52
StoTisteg Дата: Четверг, 03.05.2018, 10:58 | Сообщение № 29
Группа: Авторы
Ранг: Старожил
Сообщений: 1017
Репутация: 86 ±
Замечаний: 0% ±

Excel 2010
[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 подставить номер гарантированно заполненной колонки.


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
Сообщение[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
Дата добавления - 03.05.2018 в 10:58
Anis625 Дата: Четверг, 03.05.2018, 11:36 | Сообщение № 30
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
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


Ругается код на строку Loop Until.
Все проверил: шапка таблицы 1-я строка, первая колонка заполнена (да и все заполнены, кроме 5-ой)
 
Ответить
Сообщение
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


Ругается код на строку Loop Until.
Все проверил: шапка таблицы 1-я строка, первая колонка заполнена (да и все заполнены, кроме 5-ой)

Автор - Anis625
Дата добавления - 03.05.2018 в 11:36
StoTisteg Дата: Четверг, 03.05.2018, 11:41 | Сообщение № 31
Группа: Авторы
Ранг: Старожил
Сообщений: 1017
Репутация: 86 ±
Замечаний: 0% ±

Excel 2010
Совсем плохой стал...[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
[/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
[/vba]

Автор - StoTisteg
Дата добавления - 03.05.2018 в 11:41
Anis625 Дата: Четверг, 03.05.2018, 11:52 | Сообщение № 32
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Совсем плохой стал...

Даааааааааааааааааааааааааааааааааааааааааааа. Получилооооооооооооооооооооооооооось =) УРААААААААААААААААААААААААААААААААААААААААА
 
Ответить
Сообщение
Совсем плохой стал...

Даааааааааааааааааааааааааааааааааааааааааааа. Получилооооооооооооооооооооооооооось =) УРААААААААААААААААААААААААААААААААААААААААА

Автор - Anis625
Дата добавления - 03.05.2018 в 11:52
Anis625 Дата: Четверг, 03.05.2018, 11:53 | Сообщение № 33
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Огромнейшая благодарность за результат =)
 
Ответить
СообщениеОгромнейшая благодарность за результат =)

Автор - Anis625
Дата добавления - 03.05.2018 в 11:53
StoTisteg Дата: Четверг, 03.05.2018, 12:10 | Сообщение № 34
Группа: Авторы
Ранг: Старожил
Сообщений: 1017
Репутация: 86 ±
Замечаний: 0% ±

Excel 2010
Anis625, кстати, теоретически в ячейке может быть написано "не выполнено". И оно тоже уйдёт в архив...


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеAnis625, кстати, теоретически в ячейке может быть написано "не выполнено". И оно тоже уйдёт в архив...

Автор - StoTisteg
Дата добавления - 03.05.2018 в 12:10
Anis625 Дата: Четверг, 03.05.2018, 13:28 | Сообщение № 35
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
StoTisteg

хммм, учту. Пока вроде такое не планируется по тексту. Но примечание какое-нибудь добавлю.
 
Ответить
Сообщение
StoTisteg

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

Автор - Anis625
Дата добавления - 03.05.2018 в 13:28
StoTisteg Дата: Четверг, 03.05.2018, 14:06 | Сообщение № 36
Группа: Авторы
Ранг: Старожил
Сообщений: 1017
Репутация: 86 ±
Замечаний: 0% ±

Excel 2010
Проще запретить писать в 5 столбец всё, кроме закрытого перечня статусов... Например, выпадающим списком.


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеПроще запретить писать в 5 столбец всё, кроме закрытого перечня статусов... Например, выпадающим списком.

Автор - StoTisteg
Дата добавления - 03.05.2018 в 14:06
Anis625 Дата: Четверг, 03.05.2018, 14:39 | Сообщение № 37
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Например, выпадающим списком

Такой вариант не подходит. Это колонка творческая. Там все что угодно может быть. Но самое главное слово "выполнено" и все производные должны сноситься в архив. Не выполнено - думаю вряд ли появится.
 
Ответить
Сообщение
Например, выпадающим списком

Такой вариант не подходит. Это колонка творческая. Там все что угодно может быть. Но самое главное слово "выполнено" и все производные должны сноситься в архив. Не выполнено - думаю вряд ли появится.

Автор - Anis625
Дата добавления - 03.05.2018 в 14:39
StoTisteg Дата: Четверг, 03.05.2018, 14:55 | Сообщение № 38
Группа: Авторы
Ранг: Старожил
Сообщений: 1017
Репутация: 86 ±
Замечаний: 0% ±

Excel 2010
Не выполнено - думаю вряд ли появится

Но предусмотреть можно, это не трудно:
[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 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
[/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 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
[/vba]

Автор - StoTisteg
Дата добавления - 03.05.2018 в 14:55
Anis625 Дата: Четверг, 03.05.2018, 17:45 | Сообщение № 39
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
это не трудно

Отлично получилось. Благодарю Вас =)
 
Ответить
Сообщение
это не трудно

Отлично получилось. Благодарю Вас =)

Автор - Anis625
Дата добавления - 03.05.2018 в 17:45
Anis625 Дата: Вторник, 19.06.2018, 16:19 | Сообщение № 40
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 147
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
StoTisteg, приветствую.

Подскажите, пожалуйста. Отлично использовал ваш макрос. После 30 строки макрос не срабатывет. То есть, слово "архив" в тексте есть (заменил слово "вып" на "архив"), а его не переносит в лист Архив.

В чем может быть загвостка?
 
Ответить
СообщениеStoTisteg, приветствую.

Подскажите, пожалуйста. Отлично использовал ваш макрос. После 30 строки макрос не срабатывет. То есть, слово "архив" в тексте есть (заменил слово "вып" на "архив"), а его не переносит в лист Архив.

В чем может быть загвостка?

Автор - Anis625
Дата добавления - 19.06.2018 в 16:19
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос строк по условию (Макросы/Sub)
  • Страница 2 из 3
  • «
  • 1
  • 2
  • 3
  • »
Поиск:

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