Страницы: 1
RSS
Есть ли событие на выделение строки?
 
Хотел для начало попросить совета - как само событие на обработку сделать удобное, чтобы на всех листах работало. Пока придумал "Макрос начинает работать при выделении всей строки с определенным номером например" Подскажите есть ли такая обработка или может предложите что-то еще как это обустроить. Делать кнопку на каждый лист как то громоздко.
Надо например 7 строку скопировать в конец листа - значения и примечания.
 
Цитата
igorbych написал: событие на обработку сделать удобное, чтобы на всех листах работало
Напишите эту обработку в модуле ЭтаКнига.  
Согласие есть продукт при полном непротивлении сторон
 
Есть события которые при выполнении запускают макрос - например изменение на листе или активации листа. Я не знаю есть ли событие на выделение строки или как это сделать?
 
Есть событие и на выделение ячейки (группы ячеек) и на активацию листа. Определитесь, что Вам нужно.
 
В модуле листа
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
В модуле книги
Код
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Согласие есть продукт при полном непротивлении сторон
 
Цитата
igorbych написал:
есть ли событие на выделение строки
Отдельного нет. Но ничто не мешает использовать SelectionChange с небольшой проверкой выделенного диапазона. Если в диапазоне 1 строка и все столбцы - выделена строка.
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Rows.Count = 1 And Target.Columns.Count = Columns.Count Then MsgBox "Привет"
End Sub
Изменено: Sceptic - 22.07.2019 23:33:03
 
В большинстве случаев для каких-то операций со строкой выделять ее нет необходимости. Да и работать со ВСЕЙ строкой тоже очень редко приходится. Я очень сомневаюсь, что у Вас заполнены все 16 384 столбца.
Вы лучше опишите ЗАДАЧУ, а не СПОСОБ, которым пытаетесь ее решить. Приложите файл-пример, в котором на одном листе Как есть, на другом Как надо
Согласие есть продукт при полном непротивлении сторон
 
Цитата
igorbych написал: Надо например 7 строку скопировать в конец листа - значения и примечания.
Код
Sub Copy7Row()
Application.ScreenUpdating = False
With ActiveSheet
    lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    .Rows(7).Copy
    .Rows(lRow).PasteSpecial (xlPasteValues)
    .Rows(lRow).PasteSpecial (xlPasteComments)
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Согласие есть продукт при полном непротивлении сторон
 
скопируйте так
Код
Rows(7).copy Cells(Rows.count,1)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Sceptic, как правильно написать чтобы макрос работал во всей книге? при размещении в код листа работает, нужно для всей книги!
 
igorbych, в модуль книги:
Код
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Rows.Count = 1 And Target.Columns.Count = Sh.Columns.Count Then MsgBox "Привет"
End Sub
 
Цитата
Sanja написал: выделять ее нет необходимости.
Это старт задачи - которой я не придумал более простое и удобное начало. Возможно есть что-то логичнее и проще.
Сама задача состоит в том что после различных многочисленных действий и операций в строке - для подведения итога ее надо скопировать в конец страницы.
Запуск макроса на событие выделение ячейки, ее правки ... (многочисленно и не требует каждого шага копирования в журнал) Логически пока одно простое на уме это выделение строки целиком - что запустит макрос который должен скопировать значения диапазона скажем от A7 до Y7 этой строки (нужна проверка на номер строки скажем 2 или 7) остальные строки при выделении не должны делать копирование.
Sanja в макросе что то мешает - происходит постоянное зацикливание копирование строки в журнал и значения копируются а примечание нет.

Цитата
Ігор Гончаренко написал: Rows(7).copy Cells(Rows.count,1)
Игорь как всегда гениально краток - наверно не правильно вставляю в код = происходит зависание ексель.
Цитата
Sceptic написал: Workbook_SheetSelectionChange
В книге заработало - разобрался в отличии от страницы.
Изменено: igorbych - 30.07.2019 22:31:06
 
Цитата
igorbych написал: нужна проверка на номер строки скажем 2 или 7
В модуль ЭтаКнига. Строки 2 или 7 будут копироваться после последней строки листа при их выделении
Код
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Application.EnableEvents = False
If Not Intersect(Target, Union(Rows(2), Rows(7))) Is Nothing Then
With Sh
    lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    .Rows(Selection.Row).Copy
    .Rows(lRow).PasteSpecial (xlPasteValues)
    .Rows(lRow).PasteSpecial (xlPasteComments)
End With
End If
Application.CutCopyMode = False
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Согласие есть продукт при полном непротивлении сторон
 
Сейчас почти все работает - если это правильнее скорректируйте чтобы не целиком строка копировалась а диапазон от колонки A до Y
Возможно не будет мешать но вдруг кто то аналогичную задачу будет под себя править
- при выделении нескольких строк скажем 5 6 7 макрос копирует в журнал строку 5 - а надо чтобы действий не было только если 2 строка выделена или только 7
 
Код
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Application.EnableEvents = False
If Not Intersect(Target, Union(Rows(2), Rows(7))) Is Nothing And Target.Rows.Count = 1 Then
With Sh
    lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    .Range(.Cells(Target.Row, "A"), .Cells(Target.Row, "Y")).Copy
    .Rows(lRow).PasteSpecial (xlPasteValues)
    .Rows(lRow).PasteSpecial (xlPasteComments)
End With
End If
Application.CutCopyMode = False
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Изменено: Sanja - 23.07.2019 12:18:08
Согласие есть продукт при полном непротивлении сторон
 
Спасибо огромное - нашелся сбой
При активации в любой ячейке строки 2 или 7 также происходит копирование
Изменено: igorbych - 23.07.2019 12:48:37
 
И еще одно злодейство мешает - любое другое копирование в любом месте - не хранит буфер обмена.
Наверно строчка ниже мешает. Подскажите она вообще для чего была нужна?
Код
Application.CutCopyMode = False
Изменено: igorbych - 23.07.2019 13:29:53
 
Код
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Application.EnableEvents = False
If Not Intersect(Target, Union(Rows(2), Rows(7))) Is Nothing And _
    Target.Rows.Count = 1 And _
        Target.Count = Columns.Count Then
    With Sh
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Range(.Cells(Target.Row, "A"), .Cells(Target.Row, "Y")).Copy
        .Rows(lRow).PasteSpecial (xlPasteValues)
        .Rows(lRow).PasteSpecial (xlPasteComments)
    End With
    Application.CutCopyMode = False
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Согласие есть продукт при полном непротивлении сторон
 
Спасибо.
 
Подскажите - на одном и том же месте периодически при выделении массива ячеек происходит выброс ошибки.

Код
Private Sub Workbook_SheetSelectionChange(ByVal Sn As Object, ByVal Target As Range)
Application.EnableEvents = False
Application.EnableEvents = False
If Not Intersect(Target, Union(Rows(2), Rows(7))) Is Nothing And _
    Target.Rows.Count = 1 And _
        Target.Count = Columns.Count Then
    With Sn
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Range(.Cells(Target.Row, "A"), .Cells(Target.Row, "DA")).Copy
        .Rows(lRow).PasteSpecial (xlPasteValues)
        .Rows(lRow).PasteSpecial (xlPasteComments)
    End With
    Application.CutCopyMode = False
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Изменено: igorbych - 09.08.2019 11:09:07
 
Уважаемый igorbych! "Ловить" ошибки - Ваша обязанность.
  • Приложите файл, сообщите номер версии системы и Excel

  • Четко опишите последовательность действий, воспроизведя которую помогающий (если повезет) получит ошибку.
Владимир
 
Дело в том что уже не раз это происходило и именно на этом месте позиционирует ошибку.

Система Винда 10 про, 64 разрядная
Ексель из офиса 2016

Однотипно выделение делается на листе в тех областях которые не должны быть реакцией выполнения макроса, и так можно делать много раз ( например 30-100) и ошибка не вываливается - но на какой то раз заклинивает и вываливается. причем лечится не путем перезапуска макроса  а только полным закрытием всех книг открытых и повторным их запуском - и опять будет все безупречно до того сто первого раза.
 
Если ошибка редкая и не понятно до конца почему она возникает попробуйте просто ее игнорировать
Код
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next
If Not Intersect(Target, Union(Rows(2), Rows(7))) Is Nothing And _
    Target.Rows.Count = 1 And _
        Target.Count = Columns.Count Then
    With Sh
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Range(.Cells(Target.Row, "A"), .Cells(Target.Row, "Y")).Copy
        .Rows(lRow).PasteSpecial (xlPasteValues)
        .Rows(lRow).PasteSpecial (xlPasteComments)
    End With
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Изменено: Sanja - 10.08.2019 07:31:50
Согласие есть продукт при полном непротивлении сторон
 
Sanja,  меня вот с #13 интересует, что за версия Excel такая непонятливая, что надо дважды
Код
Application.EnableEvents = False
Application.EnableEvents = False
 :D
а вот
Цитата
Sanja написал:
просто ее игнорировать
надо осторожно, ведь после этого фактически всегда будет выполняться то что должно при условии выполнения условия. Я б посоветовал сперва проверить на ошибку и выдать сообщение что пошло что-то не так .
По вопросам из тем форума, личку не читаю.
 
Цитата
БМВ написал: надо дважды
Упс...Исправил
Цитата
БМВ написал: надо осторожно
Безусловно согласен
Цитата
БМВ написал: выдать сообщение что пошло что-то не так
Сообщение, собственно, компилятор выдает. Про Metod 'Intersect'...
Согласие есть продукт при полном непротивлении сторон
 
Да, лучше разнести проверку по разным уровням
Код
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim inRange As Range
On Error Resume Next
Set inRange = Intersect(Target, Union(Rows(2), Rows(7)))
If Err <> 0 Then
    MsgBox "Что-то пошло не так!", vbCritical
    Exit Sub
End If
If Not inRange Is Nothing Then
    If Target.Rows.Count = 1 And Target.Count = Columns.Count Then
        With Sh
            lRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            .Range(.Cells(Target.Row, "A"), .Cells(Target.Row, "Y")).Copy
            .Rows(lRow).PasteSpecial (xlPasteValues)
            .Rows(lRow).PasteSpecial (xlPasteComments)
        End With
    End If
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Согласие есть продукт при полном непротивлении сторон
 
Перестал выполняться код, Посмотрите что не так.
lRow = останавливается на этом месте.
Изменено: igorbych - 12.08.2019 08:49:38
 
Нужно объявлять все переменные. В начале процедуры:
Код
Dim lRow As Long
 
Спасибо, заработало.
Страницы: 1
Наверх