Здравствуйте! Помогите, пожалуйста, с написанием макроса - если это возможно?! Есть основной лист с базой, необходимо по заданным критериям, а именно оценка ученика, вывести все строки в отдельный лист согласно оценки. То есть, если ученики получили 2, то вывести их на лист 2, если 3 то на 3 и тд. В примере файл, где листы с оценками были заполнены вручную - вдруг просто непонятно объяснил. Заранее благодарен за ответ!
Здравствуйте! Помогите, пожалуйста, с написанием макроса - если это возможно?! Есть основной лист с базой, необходимо по заданным критериям, а именно оценка ученика, вывести все строки в отдельный лист согласно оценки. То есть, если ученики получили 2, то вывести их на лист 2, если 3 то на 3 и тд. В примере файл, где листы с оценками были заполнены вручную - вдруг просто непонятно объяснил. Заранее благодарен за ответ!yakutt-1573
yakutt-1573, и без макросов, как не просили, но с тем же результатом. [offtop]Эх а у нас у математика в старших классах система оценок была от 1-,1,1+,2-,2,2+, 3-, 3 еле, 3еле еле, 3,3+,.......... 5+ [/offtop]
yakutt-1573, и без макросов, как не просили, но с тем же результатом. [offtop]Эх а у нас у математика в старших классах система оценок была от 1-,1,1+,2-,2,2+, 3-, 3 еле, 3еле еле, 3,3+,.......... 5+ [/offtop]bmv98rus
Sub www() Dim o& Application.ScreenUpdating = False For o = 2 To 5 Sheets(CStr(o)).[A1].CurrentRegion.ClearContents With Sheets("ОСНОВНОЙ").[A1].CurrentRegion .AutoFilter Field:=o + 2, Criteria1:="=" & o .Columns(1).SpecialCells(12).Copy Sheets(CStr(o)).[A1] .Columns(2).SpecialCells(12).Copy Sheets(CStr(o)).[B1] .Columns(o + 2).SpecialCells(12).Copy Sheets(CStr(o)).[C1] .Parent.AutoFilterMode = 0 End With Next o Application.ScreenUpdating = True End Sub
[/vba] Если нужен только список фамилий, то удалите строчку [vba]
Sub www() Dim o& Application.ScreenUpdating = False For o = 2 To 5 Sheets(CStr(o)).[A1].CurrentRegion.ClearContents With Sheets("ОСНОВНОЙ").[A1].CurrentRegion .AutoFilter Field:=o + 2, Criteria1:="=" & o .Columns(1).SpecialCells(12).Copy Sheets(CStr(o)).[A1] .Columns(2).SpecialCells(12).Copy Sheets(CStr(o)).[B1] .Columns(o + 2).SpecialCells(12).Copy Sheets(CStr(o)).[C1] .Parent.AutoFilterMode = 0 End With Next o Application.ScreenUpdating = True End Sub
[/vba] Если нужен только список фамилий, то удалите строчку [vba]