код для макроса

[oboevrulon]

привет у меня вопрос, точнее нужен код для макроса в exel...

A B
сиги 0
трава 1
алкоголь 5

с помощью макроса сделать так чтобы макрос создавал новый лист, и туда сортировал данные только те, у которых значение B отличное от нуля, ну если можно по возрастанию... тоесть должно получиться

A B
трава 1
алкоголь 5

A, B - столбцы

[EducatedFool]

Макрос-то несложный - около 6 строк кода.

Вот только сделать его универсальным (чтобы он подходил к любым файлам) намного сложнее.

Будет файл - будет код.

[oboevrulon]

вот файлик... там я сделал в одном листе два, в первом листе 2 таблицы.. первый и второй лист, первый можно оставить так как это исходная таблица, вот таблица с названием лист 2 это то что должно получиться... спасибо...

[EducatedFool]

Вот весь код:

Sub main()
    Const НомерСтолбцаСКоличеством = 4, НомерСтолбцаСоСтоимостью = 6
    On Error Resume Next: Application.ScreenUpdating = False
    Dim sh As Worksheet, sumCell As Range: Set sh = ActiveSheet: sh.Copy sh: Set sh = ActiveSheet
    sh.Shapes.SelectAll: Selection.Delete: sh.Name = "Выборка " & Format(Now, "HH-NN-SS")
    For i = sh.Cells(Rows.Count, НомерСтолбцаСКоличеством).End(xlUp).Row To 2 Step -1
        If Val(Cells(i, НомерСтолбцаСКоличеством)) = 0 Then Rows(i).Delete
    Next
    sh.UsedRange.Sort [d1], xlAscending, , , , , , xlYes
    Set sumCell = sh.Cells(Rows.Count, НомерСтолбцаСоСтоимостью).End(xlUp).Offset(1)
    If sumCell.Row > 3 Then
        sumCell.Formula = "=sum(" & Range(sumCell.Offset(-1), sumCell.EntireColumn.Cells(2)).Address & ")"
        sumCell.Font.Bold = True
    End If
End Sub

Нажмите зелёную кнопочку:

[oboevrulon]

мегаспасибо! еще не проверял, проверю отредактирую это сообщение! крутан! ) не думал что напишешь ))

[oboevrulon]

EducatedFool, а можно попросить Вас, прокоментировать код... просто хочу разобраться что и как, а вообще я сам сделал через конструктор макрос, но когда включаешь защиту ячеек, он отказывается работать, Ваш работает код, не могли бы прокомментировать его

[EducatedFool]

Sub main()
    ' константы - лишь для удобства изменения макроса в даньшейшем (если порядок столбцов изменится)
    Const НомерСтолбцаСКоличеством = 4, НомерСтолбцаСоСтоимостью = 6

    On Error Resume Next    ' отключаем остановку при возникновении ошибок
    Application.ScreenUpdating = False    ' отключаем обновление экрана
    Dim sh As Worksheet, sumCell As Range:
    Set sh = ActiveSheet:    ' берём активный лист (в переменную sh)
    sh.Copy sh:    ' и копируем его
    Set sh = ActiveSheet    ' теперь переменная sh ссылается уже на КОПИЮ листа
    sh.Shapes.SelectAll: Selection.Delete:    ' выделяем все автофигуры (кнопки) и удаляем их
    sh.Name = "Выборка " & Format(Now, "HH-NN-SS")    ' изменяем имя листа
    For i = sh.Cells(Rows.Count, НомерСтолбцаСКоличеством).End(xlUp).Row To 2 Step -1
        ' удаляем ненужные строки (где Количество не указано, или равно нулю)
        If Val(Cells(i, НомерСтолбцаСКоличеством)) = 0 Then Rows(i).Delete
    Next
    sh.UsedRange.Sort [d1], xlAscending, , , , , , xlYes    ' сортируем таблицу

    ' ищем ячейку ддля вставки суммы
    Set sumCell = sh.Cells(Rows.Count, НомерСтолбцаСоСтоимостью).End(xlUp).Offset(1)

    If sumCell.Row > 3 Then    ' если у нас не менее 2 строк с данными в таблице
        ' пишем в ячейку формулу суммы
        sumCell.Formula = "=sum(" & Range(sumCell.Offset(-1), sumCell.EntireColumn.Cells(2)).Address & ")"
        sumCell.Font.Bold = True    ' делаем шрифт полужирным
    End If
End Sub

вообще я сам сделал через конструктор макрос

Научите меня тоже, пожалуйста, делать такие макросы через "конструктор".
А то я даже не знаю, что такое конструктор макросов...

[oboevrulon]

Сообщение от EducatedFool

Sub main()
    ' константы - лишь для удобства изменения макроса в даньшейшем (если порядок столбцов изменится)
    Const НомерСтолбцаСКоличеством = 4, НомерСтолбцаСоСтоимостью = 6

    On Error Resume Next    ' отключаем остановку при возникновении ошибок
    Application.ScreenUpdating = False    ' отключаем обновление экрана
    Dim sh As Worksheet, sumCell As Range:
    Set sh = ActiveSheet:    ' берём активный лист (в переменную sh)
    sh.Copy sh:    ' и копируем его
    Set sh = ActiveSheet    ' теперь переменная sh ссылается уже на КОПИЮ листа
    sh.Shapes.SelectAll: Selection.Delete:    ' выделяем все автофигуры (кнопки) и удаляем их
    sh.Name = "Выборка " & Format(Now, "HH-NN-SS")    ' изменяем имя листа
    For i = sh.Cells(Rows.Count, НомерСтолбцаСКоличеством).End(xlUp).Row To 2 Step -1
        ' удаляем ненужные строки (где Количество не указано, или равно нулю)
        If Val(Cells(i, НомерСтолбцаСКоличеством)) = 0 Then Rows(i).Delete
    Next
    sh.UsedRange.Sort [d1], xlAscending, , , , , , xlYes    ' сортируем таблицу

    ' ищем ячейку ддля вставки суммы
    Set sumCell = sh.Cells(Rows.Count, НомерСтолбцаСоСтоимостью).End(xlUp).Offset(1)

    If sumCell.Row > 3 Then    ' если у нас не менее 2 строк с данными в таблице
        ' пишем в ячейку формулу суммы
        sumCell.Formula = "=sum(" & Range(sumCell.Offset(-1), sumCell.EntireColumn.Cells(2)).Address & ")"
        sumCell.Font.Bold = True    ' делаем шрифт полужирным
    End If
End Sub

огромное спасибо

Научите меня тоже, пожалуйста, делать такие макросы через "конструктор".
А то я даже не знаю, что такое конструктор макросов...

жошь я эээ... тебе то незнать )