В прикрепленном файле "Подбор трубы для ЦЗЛ" есть два листа и один макрос.
Необходимо с листа "ЦЗЛ" перенести данные строки в столбцах с 1-5 (A-E) в лист "Отдел", по результату "Да" отмеченному зеленым цветом в столбце M(№13). Обе таблицу будут заполнятся и представлять собой базу данных. , В VBA не силен прописал код, но не работает!
[vba]
Код
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub
Dim iLast As Long iLast = Me.Columns("A").Find(what:="*", _ LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Row ' Debug.Print iLast
If Not Intersect(Target, Range("M3:M" & iLast)) Is Nothing Then
If Target.Offset(0).DisplayFormat.Interior.Color = RGB(153, 204, 0) Then
With ThisWorkbook.Worksheets("Отдел")
Dim lr As Long lr = .Columns("F").Find(what:="*", _ LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Row ' Debug.Print lr .Cells(lr + 1, 1) = Cells(Target.Row, 1) ' A .Cells(lr + 1, 2) = Cells(Target.Row, 2) ' B .Cells(lr + 1, 3) = Cells(Target.Row, 3) ' C .Cells(lr + 1, 4) = Cells(Target.Row, 4) ' D .Cells(lr + 1, 5) = Cells(Target.Row, 5) ' E .Cells.Columns.AutoFit End With
End If
End If
End Sub
[/vba]
Спасибо!
Добрый день уважаемые знатоки!
В прикрепленном файле "Подбор трубы для ЦЗЛ" есть два листа и один макрос.
Необходимо с листа "ЦЗЛ" перенести данные строки в столбцах с 1-5 (A-E) в лист "Отдел", по результату "Да" отмеченному зеленым цветом в столбце M(№13). Обе таблицу будут заполнятся и представлять собой базу данных. , В VBA не силен прописал код, но не работает!
[vba]
Код
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub
Dim iLast As Long iLast = Me.Columns("A").Find(what:="*", _ LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Row ' Debug.Print iLast
If Not Intersect(Target, Range("M3:M" & iLast)) Is Nothing Then
If Target.Offset(0).DisplayFormat.Interior.Color = RGB(153, 204, 0) Then
With ThisWorkbook.Worksheets("Отдел")
Dim lr As Long lr = .Columns("F").Find(what:="*", _ LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Row ' Debug.Print lr .Cells(lr + 1, 1) = Cells(Target.Row, 1) ' A .Cells(lr + 1, 2) = Cells(Target.Row, 2) ' B .Cells(lr + 1, 3) = Cells(Target.Row, 3) ' C .Cells(lr + 1, 4) = Cells(Target.Row, 4) ' D .Cells(lr + 1, 5) = Cells(Target.Row, 5) ' E .Cells.Columns.AutoFit End With
DenchikZ, Добрый день. Не работает потому что Private Sub Worksheet_Change - это событие изменения ячейки, но ячейка при пересчёте не меняется. Вбейте в неё вручную что-то и код сработает. Но т.к. код не находит Interior.Color = RGB(153, 204, 0) то на этом и всё. Т.е. две причины - нет изменений, не тот цвет. Когда это поправится - далее косяк на lr = .Columns("F").Find(... нет там в F ничего... Вот эти 3 места поправить и полетит.
DenchikZ, Добрый день. Не работает потому что Private Sub Worksheet_Change - это событие изменения ячейки, но ячейка при пересчёте не меняется. Вбейте в неё вручную что-то и код сработает. Но т.к. код не находит Interior.Color = RGB(153, 204, 0) то на этом и всё. Т.е. две причины - нет изменений, не тот цвет. Когда это поправится - далее косяк на lr = .Columns("F").Find(... нет там в F ничего... Вот эти 3 места поправить и полетит.Hugo
Ну или можно иначе - указать чуть другой зелёный в УФ, это уж как хозяин решит. Но это не заставит код работать, нужно другие ячейки отслеживать, но мы не в курсе техпроцесса... Ну и со вторым листом нам тоже неведомо в каком столбце точно будет заполнена последняя строка.
Ну или можно иначе - указать чуть другой зелёный в УФ, это уж как хозяин решит. Но это не заставит код работать, нужно другие ячейки отслеживать, но мы не в курсе техпроцесса... Ну и со вторым листом нам тоже неведомо в каком столбце точно будет заполнена последняя строка.Hugo
Hugo, получается нужно переносить данные строк в 5 первых столбцах по значению которое выпадает по формуле в столбце M, то есть там если выпадет Да с выделенным зеленым цветом то нужно данные этой строки по 5 первым столбцам перенести в лист Отдел
Hugo, получается нужно переносить данные строк в 5 первых столбцах по значению которое выпадает по формуле в столбце M, то есть там если выпадет Да с выделенным зеленым цветом то нужно данные этой строки по 5 первым столбцам перенести в лист ОтделDenchikZ
Это понятно. Но там этих "Да" много, а у события пересчёта нет Target, и зачем усложнять. Думаю проще отслеживать те столбцы куда вносите руками чтоб получилось это Да, и проверять что Да есть в М. P.S. Отвечал на предыдущее
Это понятно. Но там этих "Да" много, а у события пересчёта нет Target, и зачем усложнять. Думаю проще отслеживать те столбцы куда вносите руками чтоб получилось это Да, и проверять что Да есть в М. P.S. Отвечал на предыдущееHugo
vanin00, Спасибо но немного не так получает он учитывает любое изменение в столбце "Н" и там может быть нет, то столбец "М" не заполнится, а строку уже перекинуло
vanin00, Спасибо но немного не так получает он учитывает любое изменение в столбце "Н" и там может быть нет, то столбец "М" не заполнится, а строку уже перекинулоDenchikZ