Примеры на миф в excel примеры

В этом уроке я покажу Вам самые популярные макросы в VBA Excel, которые вы сможете использовать для оптимизации своей работы. VBA — это язык программирования, который может использоваться для расширения возможностей MS Excel и других приложений MS Office. Это чрезвычайно полезно для пользователей MS Excel, поскольку VBA может использоваться для автоматизации вашей работы и значительно увеличить Вашу эффективность. В этой статье Вы познакомитесь с VBA и я вам покажу некоторые из наиболее полезных, готовых к использованию примеров VBA. Вы сможете использовать эти примеры для создания собственных скриптов, соответствующих Вашим потребностям.

Вам не нужен опыт программирования, чтобы воспользоваться информаций из этой статьи, но вы должны иметь базовые знания Excel. Если вы еще учитесь работать с Excel, я бы рекомендовал Вам прочитать статью 20 формул Excel, которые вам нeобходимо выучить сейчас, чтобы узнать больше о функциональных возможностях Excel.

Я подготовил для вас несколько самых полезных примеров VBA Excel с большой функциональностью, которую вы сможете использовать для оптимизации своей работы. Чтобы их использовать, вам необходимо записать их в файл. Следующий параграф посвящен установке макроса Excel. Пропустите эту часть, если вы уже знакомы с этим.

Table of Contents

Как включить макросы в Excel

В Excel нажмите комбинацию клавиш alt + F11. Это приведет вас к редактору VBA в MS Excel. Затем щелкните правой кнопкой мыши папку Microsoft Excel Objects слева и выберите Insert => Module. Это место, где сохраняются макросы. Чтобы использовать макрос, вам нужно сохранить документ Excel как макрос. Из табуляции File => Save as, выберите Save as macro-enabled Workbok (расширение .xlsm) Теперь пришло время написать свой первый макрос!

1. Копирование данных из одного файла в другой.

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

Sub CopyFiletoAnotherWorkbook()
    
        Sheets("Example 1").Range("B4:C15").Copy
    
        Workbooks.Add
    
        ActiveSheet.Paste
    
        Application.DisplayAlerts = False
    
        ActiveWorkbook.SaveAs Filename:="C:TempMyNewBook.xlsx"
    
        Application.DisplayAlerts = True
End Sub

2. Отображение скрытых строк

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

Sub ShowHiddenRows()
    Columns.EntireColumn.Hidden = False
    Rows.EntireRow.Hidden = False
End Sub

3. Удаление пустых строк и столбов

Пустые строки в Excel — может быть проблемой для обработки данных. Вот как избавиться от них:

Sub DeleteEmptyRowsAndColumns()
    
        Dim MyRange As Range
        Dim iCounter As Long
    
        Set MyRange = ActiveSheet.UsedRange
        
        For iCounter = MyRange.Rows.Count To 1 Step -1
    
           If Application.CountA(Rows(iCounter).EntireRow) = 0 Then
               Rows(iCounter).Delete
               
               
           End If
    
        Next iCounter
    
        For iCounter = MyRange.Columns.Count To 1 Step -1
    
               If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then
                Columns(iCounter).Delete
               End If
    
        Next iCounter      
End Sub

4. Нахождение пустых ячеек

Sub FindEmptyCell()
    ActiveCell.Offset(1, 0).Select
       Do While Not IsEmpty(ActiveCell)
          ActiveCell.Offset(1, 0).Select
       Loop
End Sub

#### 5. Заполнение пустых ячеек

Как упоминалось ранее, пустые ячейки препятствуют обработке данных и созданию сводных таблиц. Вот один примерный код, который заменяет все пустые ячейки на 0. Этот макрос имеет очень большое приложение, потому что Вы можете использовать его для поиска и замены результатов N/A, а также других символов, таких как точки, запятые или повторяющиеся значения:

Sub FindAndReplace()
    
        Dim MyRange As Range
        Dim MyCell As Range
    
        Select Case MsgBox("Can't Undo this action.  " & _
                            "Save Workbook First?", vbYesNoCancel)
            Case Is = vbYes
            ThisWorkbook.Save
            Case Is = vbCancel
            Exit Sub
        End Select
    
        Set MyRange = Selection
    
        For Each MyCell In MyRange
    
            If Len(MyCell.Value) = 0 Then
                MyCell = 0
            End If
    
        Next MyCell
End Sub

#### 6. Сортировка данных

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

NB: Здесь нам нужно поставить этот код в Sheet1 (папка Microsoft Excel Objects), а не в Module1 (папка Modules):

Private Sub Worksheet_BeforeDoubleClick (ByVal Target as Range, Cancel As Boolean)
    
        Dim LastRow As Long
    
        LastRow = Cells (Rows.Count, 1) .End (xlUp) .Row
    
        Rows ("6:" & LastRow) .Sort _
        Key1: = Cells (6, ActiveCell.Column), _
        Order1: = xlAscending
End Sub

#### 7. Удаление пустых пространств

Иногда данные в книге содержат дополнительные пробелы (whitespace charachters), которые могут мешать анализу данных и коррумпировать формулы. Вот один макрос, который удалит все пробелы из предварительно выбранного диапазона ячеек:

Sub TrimTheSpaces()
    
        Dim MyRange As Range
        Dim MyCell As Range
    
        Select Case MsgBox("Can't Undo this action.  " & _
                            "Save Workbook First?", vbYesNoCancel)
            Case Is = vbYes
            ThisWorkbook.Save
            Case Is = vbCancel
            Exit Sub
        End Select
    
        Set MyRange = Selection
    
        For Each MyCell In MyRange
    
            If Not IsEmpty(MyCell) Then
                MyCell = Trim(MyCell)
            End If
    
        Next MyCell
End Sub

#### 8. Выделение дубликатов цветом

Иногда в нескольких столбцах, которые мы хотели бы осветить, есть повторяющиеся значения. Этот макрос делает именно это:

Sub HighlightDuplicates()
    
        Dim MyRange As Range
        Dim MyCell As Range
    
        Set MyRange = Selection 
    
        For Each MyCell In MyRange 
    
            If WorksheetFunction.CountIf(MyRange, MyCell.Value) > 1 Then
                MyCell.Interior.ColorIndex = 36
            End If
    
        Next MyCell
End Sub

#### 9. Выделение десяти самых высоких чисел

Этот код будет отображать десять самых высоких чисел из набора ячеек:

Sub TopTen()
    Selection.FormatConditions.AddTop10
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1)
            .TopBottom = xlTop10Top
            
            .Rank = 10
            .Percent = False
        End With
        With Selection.FormatConditions(1).Font
            .Color = -16752384
            .TintAndShade = 0
        End With
        With Selection.FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 13561798
            .TintAndShade = 0
        End With
    Selection.FormatConditions(1).StopIfTrue = False
End Sub

Вы можете легко настроить код, чтобы выделить различное количество чисел.

#### 10. Выделение данных больших чем данные число

Когда вы запустите этот код, появится окно. Вам надо написать число, которое вы хотите сравнить с выбранными ячейками.

Sub HighlightGreaterThanValues()
    Dim i As Integer
    i = InputBox("Enter Greater Than Value", "Enter Value")
    Selection.FormatConditions.Delete
    
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:=i
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1)
            .Font.Color = RGB(0, 0, 0)
            .Interior.Color = RGB(31, 218, 154)
        End With
End Sub

Вы тоже можете настроить этот код, чтобы выделить более низкие чисел.

#### 11. Выделение ячеек комментариями
Простой макрос, который выделяет все ячейки, содержащие комментарии:

Sub HighlightCommentCells()
    Selection.SpecialCells(xlCellTypeComments).Select
    Selection.Style= "Note"
End Sub

#### 12. Выделение ячеек со словами с ошибками

Это очень полезно, когда вы работаете с функциями, которые принимают строки, однако кто-то ввел строку с ошибкой, и ваши формулы не работают. Вот как решить эту проблему:

 Sub ColorMispelledCells()
    For Each cl In ActiveSheet.UsedRange
        If Not Application.CheckSpelling(Word:=cl.Text) Then _
        cl.Interior.ColorIndex = 28
    Next cl
End Sub

13. Создание сводной таблицы

Вот как создать сводную таблицу в MS Excel (версия 2007). Особенно полезно, когда вы делаете индивидуальный отчет каждый день. Вы можете оптимизировать создание сводной таблицы следующим образом:

Sub PivotTableForExcel2007()
    Dim SourceRange As Range
    Set SourceRange = Sheets("Sheet1").Range("A3:N86")
    ActiveWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=SourceRange, _
    Version:=xlPivotTableVersion12).CreatePivotTable _
    TableDestination:="", _
    TableName:="", _
    DefaultVersion:=xlPivotTableVersion12
End Sub

14. Отправка активного файла по электронной почте

Мой любимый код VBA. Он позволяет вам прикреплять и отправлять файл, с которым вы работаете, с предопределенным адресом электронной почты, заголовком сообщения и телом сообщения! Сначала Вам нужно сделать референцию в Excel на Microsoft Outlook (в редакторе Excel VBA, нажмите tools => references и выберите Microsoft Outlook).

Sub SendFIleAsAttachment()
    
    
        Dim OLApp As Outlook.Application
        Dim OLMail As Object
    
        Set OLApp = New Outlook.Application
        Set OLMail = OLApp.CreateItem(0)
        OLApp.Session.Logon  
    
        With OLMail
        .To = "admin@datapigtechnologies.com; mike@datapigtechnologies.com"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = "Hi there"
        .Attachments.Add ActiveWorkbook.FullName
        .Display  
        End With
    
        Set OLMail = Nothing
        Set OLApp = Nothing
End Sub

15. Вставка всех графиков Excel в презентацию PowerPoint

Очень удобный макрос, который позволяет вам добавлять все ваши графики Excel в презентацию Powerpoint одним щелчком мыши:

Sub SendExcelFiguresToPowerPoint()
    
    
        Dim PP As PowerPoint.Application
        Dim PPPres As PowerPoint.Presentation
        Dim PPSlide As PowerPoint.Slide
        Dim i As Integer
    
        Sheets("Slide Data").Select
            If ActiveSheet.ChartObjects.Count < 1 Then
                MsgBox "No charts existing the active sheet"
                Exit Sub
            End If
    
        Set PP = New PowerPoint.Application
        Set PPPres = PP.Presentations.Add
        PP.Visible = True
    
            For i = 1 To ActiveSheet.ChartObjects.Count
            
                ActiveSheet.ChartObjects(i).Chart.CopyPicture _
                Size:=xlScreen, Format:=xlPicture
                Application.Wait (Now + TimeValue("0:00:1"))
            
                ppSlideCount = PPPres.Slides.Count
                Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
                PPSlide.Select
            
                PPSlide.Shapes.Paste.Select
                PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
                PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
            Next i
    
        Set PPSlide = Nothing
        Set PPPres = Nothing
        Set PP = Nothing
End Sub

16. Вставка таблицы Excel в MS Word

Таблицы Excel обычно помещаются внутри текстовых документов. Вот один автоматический способ экспорта таблицы Excel в MS Word:

 Sub ExcelTableInWord()
    
    
        Dim MyRange As Excel.Range
        Dim wd As Word.Application
        Dim wdDoc As Word.Document
        Dim WdRange As Word.Range
    
       Sheets("Revenue Table").Range("B4:F10").Cop
    
        Set wd = New Word.Application
        Set wdDoc = wd.Documents.Open _
        (ThisWorkbook.Path & "" & "PasteTable.docx")
        wd.Visible = True
    
        Set WdRange = wdDoc.Bookmarks("DataTableHere").Rangе
    
        On Error Resume Next
        WdRange.Tables(1).Delete
        WdRange.Paste 
    
        WdRange.Tables(1).Columns.SetWidth _
        (MyRange.Width / MyRange.Columns.Count), wdAdjustSameWidth
    
        wdDoc.Bookmarks.Add "DataTableHere", WdRange
    
        Set wd = Nothing
        Set wdDoc = Nothing
        Set WdRange = Nothing
End Sub

17. Извлечение слов из текста

Мы можем использовать формулы, если хотим извлечь определенное количество символов. Но что, если мы хотим извлечь только одно слово из предложения или диапазон слов в ячейке? Для этого мы можем сами создать функцию Excel с помощью VBA. Это одна из самых удобных функций VBA, поскольку она позволяет создавать собственные формулы, которые отсутствуют в MS Excel. Давайте продолжим и создадим две функции: findword() и findwordrev():

Function FindWord(Source As String, Position As Integer) As String
     On Error Resume Next
     FindWord = Split(WorksheetFunction.Trim(Source), " ")(Position - 1)
     On Error GoTo 0
End Function

Function FindWordRev(Source As String, Position As Integer) As String
     Dim Arr() As String
     Arr = VBA.Split(WorksheetFunction.Trim(Source), " ")
     On Error Resume Next
     FindWordRev = Arr(UBound(Arr) - Position + 1)
     On Error GoTo 0
End Function

Отлично, мы уже создали две новые функции в Excel! Теперь попробуйте использовать их в Excel. Функция = FindWordRev (A1,1) берет последнее слово из ячейки A1. Функция = FindWord (A1,3) берет третье слово из ячейки A1 и т. Д.

18. Защита данных в MS Excel

Иногда мы хотим защитить данных нашего файла, чтобы только мы могли его изменять. Вот как это сделать с VBA:

Sub ProtectSheets()
    
        Dim ws As Worksheet
    
        For Each ws In ActiveWorkbook.Worksheets
    
        ws.Protect Password:="1234"
        Next ws
End Sub

Поздравления! Поскольку вы все еще читаете это, вы действительно заинтересованы в изучении VBA. Как вы уже сами видели, язык программирования VBA чрезвычайно полезен и может сэкономить нам много времени. Надеюсь, вы нашли эту информацию полезной и использовали ее, чтобы стать мастером MS Excel, VBA и компьютерных наук в целом.

© 2018 Атанас Йонков

---

Литература:

1. ExcelChamps.com: Top 100 Useful Excel Macro [VBA] Codes Examples.

2. Michael Alexander, John Walkenbach (2012). 101 Ready-To-Use Excel Macros.

3. BG Excel.info: 14 ready-to-use Macros for Excel.

Время на прочтение
7 мин

Количество просмотров 312K

Приветствую всех.

В этом посте я расскажу, что такое VBA и как с ним работать в Microsoft Excel 2007/2010 (для более старых версий изменяется лишь интерфейс — код, скорее всего, будет таким же) для автоматизации различной рутины.

VBA (Visual Basic for Applications) — это упрощенная версия Visual Basic, встроенная в множество продуктов линейки Microsoft Office. Она позволяет писать программы прямо в файле конкретного документа. Вам не требуется устанавливать различные IDE — всё, включая отладчик, уже есть в Excel.

Еще при помощи Visual Studio Tools for Office можно писать макросы на C# и также встраивать их. Спасибо, FireStorm.

Сразу скажу — писать на других языках (C++/Delphi/PHP) также возможно, но требуется научится читать, изменять и писать файлы офиса — встраивать в документы не получится. А интерфейсы Microsoft работают через COM. Чтобы вы поняли весь ужас, вот Hello World с использованием COM.

Поэтому, увы, будем учить Visual Basic.

Чуть-чуть подготовки и постановка задачи

Итак, поехали. Открываем Excel.

Для начала давайте добавим в Ribbon панель «Разработчик». В ней находятся кнопки, текстовые поля и пр. элементы для конструирования форм.

Появилась вкладка.

Теперь давайте подумаем, на каком примере мы будем изучать VBA. Недавно мне потребовалось красиво оформить прайс-лист, выглядевший, как таблица. Идём в гугл, набираем «прайс-лист» и качаем любой, который оформлен примерно так (не сочтите за рекламу, пожалуйста):

То есть требуется, чтобы было как минимум две группы, по которым можно объединить товары (в нашем случае это будут Тип и Производитель — в таком порядке). Для того, чтобы предложенный мною алгоритм работал корректно, отсортируйте товары так, чтобы товары из одной группы стояли подряд (сначала по Типу, потом по Производителю).

Результат, которого хотим добиться, выглядит примерно так:

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

Кодим

Для начала требуется создать кнопку, при нажатии на которую будет вызываться наша програма. Кнопки находятся в панели «Разработчик» и появляются по кнопке «Вставить». Вам нужен компонент формы «Кнопка». Нажали, поставили на любое место в листе. Далее, если не появилось окно назначения макроса, надо нажать правой кнопкой и выбрать пункт «Назначить макрос». Назовём его FormatPrice. Важно, чтобы перед именем макроса ничего не было — иначе он создастся в отдельном модуле, а не в пространстве имен книги. В этому случае вам будет недоступно быстрое обращение к выделенному листу. Нажимаем кнопку «Новый».

И вот мы в среде разработки VB. Также её можно вызвать из контекстного меню командой «Исходный текст»/«View code».

Перед вами окно с заглушкой процедуры. Можете его развернуть. Код должен выглядеть примерно так:

Sub FormatPrice()End Sub

Напишем Hello World:

Sub FormatPrice()
    MsgBox "Hello World!"
End Sub

И запустим либо щелкнув по кнопке (предварительно сняв с неё выделение), либо клавишей F5 прямо из редактора.

Тут, пожалуй, следует отвлечься на небольшой ликбез по поводу синтаксиса VB. Кто его знает — может смело пропустить этот раздел до конца. Основное отличие Visual Basic от Pascal/C/Java в том, что команды разделяются не ;, а переносом строки или двоеточием (:), если очень хочется написать несколько команд в одну строку. Чтобы понять основные правила синтаксиса, приведу абстрактный код.

Примеры синтаксиса

' Процедура. Ничего не возвращает
' Перегрузка в VBA отсутствует
Sub foo(a As String, b As String)
    ' Exit Sub ' Это значит "выйти из процедуры"
    MsgBox a + ";" + b
End Sub' Функция. Вовращает Integer
Function LengthSqr(x As Integer, y As Integer) As Integer
    ' Exit Function
    LengthSqr = x * x + y * y
End FunctionSub FormatPrice()
    Dim s1 As String, s2 As String
    s1 = "str1"
    s2 = "str2"
    If s1 <> s2 Then
        foo "123", "456" ' Скобки при вызове процедур запрещены
    End IfDim res As sTRING ' Регистр в VB не важен. Впрочем, редактор Вас поправит
    Dim i As Integer
    ' Цикл всегда состоит из нескольких строк
    For i = 1 To 10
        res = res + CStr(i) ' Конвертация чего угодно в String
        If i = 5 Then Exit For
    Next iDim x As Double
    x = Val("1.234") ' Парсинг чисел
    x = x + 10
    MsgBox xOn Error Resume Next ' Обработка ошибок - игнорировать все ошибки
    x = 5 / 0
    MsgBox xOn Error GoTo Err ' При ошибке перейти к метке Err
    x = 5 / 0
    MsgBox "OK!"
    GoTo ne

Err:
    MsgBox 

"Err!"

ne:

On Error GoTo 0 ' Отключаем обработку ошибок

    ' Циклы бывает, какие захотите
    Do While True
        Exit DoLoop 'While True
    Do 'Until False
        Exit Do
    Loop Until False
    ' А вот при вызове функций, от которых хотим получить значение, скобки нужны.
    ' Val также умеет возвращать Integer
    Select Case LengthSqr(Len("abc"), Val("4"))
    Case 24
        MsgBox "0"
    Case 25
        MsgBox "1"
    Case 26
        MsgBox "2"
    End Select' Двухмерный массив.
    ' Можно также менять размеры командой ReDim (Preserve) - см. google
    Dim arr(1 to 10, 5 to 6) As Integer
    arr(1, 6) = 8Dim coll As New Collection
    Dim coll2 As Collection
    coll.Add "item", "key"
    Set coll2 = coll ' Все присваивания объектов должны производится командой Set
    MsgBox coll2("key")
    Set coll2 = New Collection
    MsgBox coll2.Count
End Sub

Грабли-1. При копировании кода из IDE (в английском Excel) есь текст конвертируется в 1252 Latin-1. Поэтому, если хотите сохранить русские комментарии — надо сохранить крокозябры как Latin-1, а потом открыть в 1251.

Грабли-2. Т.к. VB позволяет использовать необъявленные переменные, я всегда в начале кода (перед всеми процедурами) ставлю строчку Option Explicit. Эта директива запрещает интерпретатору заводить переменные самостоятельно.

Грабли-3. Глобальные переменные можно объявлять только до первой функции/процедуры. Локальные — в любом месте процедуры/функции.

Еще немного дополнительных функций, которые могут пригодится: InPos, Mid, Trim, LBound, UBound. Также ответы на все вопросы по поводу работы функций/их параметров можно получить в MSDN.

Надеюсь, что этого Вам хватит, чтобы не пугаться кода и самостоятельно написать какое-нибудь домашнее задание по информатике. По ходу поста я буду ненавязчиво знакомить Вас с новыми конструкциями.

Кодим много и под Excel

В этой части мы уже начнём кодить нечто, что умеет работать с нашими листами в Excel. Для начала создадим отдельный лист с именем result (лист с данными назовём data). Теперь, наверное, нужно этот лист очистить от того, что на нём есть. Также мы «выделим» лист с данными, чтобы каждый раз не писать длинное обращение к массиву с листами.

Sub FormatPrice()
    Sheets("result").Cells.Clear
    Sheets("data").Activate
End Sub

Работа с диапазонами ячеек

Вся работа в Excel VBA производится с диапазонами ячеек. Они создаются функцией Range и возвращают объект типа Range. У него есть всё необходимое для работы с данными и/или оформлением. Кстати сказать, свойство Cells листа — это тоже Range.

Примеры работы с Range

Sheets("result").Activate
Dim r As Range
Set r = Range("A1")
r.Value = "123"
Set r = Range("A3,A5")
r.Font.Color = vbRed
r.Value = "456"
Set r = Range("A6:A7")
r.Value = "=A1+A3"

Теперь давайте поймем алгоритм работы нашего кода. Итак, у каждой строчки листа data, начиная со второй, есть некоторые данные, которые нас не интересуют (ID, название и цена) и есть две вложенные группы, к которым она принадлежит (тип и производитель). Более того, эти строки отсортированы. Пока мы забудем про пропуски перед началом новой группы — так будет проще. Я предлагаю такой алгоритм:

1. Считали группы из очередной строки.
2. Пробегаемся по всем группам в порядке приоритета (вначале более крупные)
   1. Если текущая группа не совпадает, вызываем процедуру AddGroup(i, name), где i — номер группы (от номера текущей до максимума), name — её имя. Несколько вызовов необходимы, чтобы создать не только наш заголовок, но и всё более мелкие.
3. После отрисовки всех необходимых заголовков делаем еще одну строку и заполняем её данными.

Для упрощения работы рекомендую определить следующие функции-сокращения:

Function GetCol(Col As Integer) As String
    GetCol = Chr(Asc("A") + Col)
End FunctionFunction GetCellS(Sheet As String, Col As Integer, Row As Integer) As Range
    Set GetCellS = Sheets(Sheet).Range(GetCol(Col) + CStr(Row))
End FunctionFunction GetCell(Col As Integer, Row As Integer) As Range
    Set GetCell = Range(GetCol(Col) + CStr(Row))
End Function

Далее определим глобальную переменную «текущая строчка»: Dim CurRow As Integer. В начале процедуры её следует сделать равной единице. Еще нам потребуется переменная-«текущая строка в data», массив с именами групп текущей предыдущей строк. Потом можно написать цикл «пока первая ячейка в строке непуста».

Глобальные переменные

Option Explicit ' про эту строчку я уже рассказывал
Dim CurRow As Integer
Const GroupsCount As Integer = 2
Const DataCount As Integer = 3

FormatPrice

Sub FormatPrice()
    Dim I As Integer ' строка в data
    CurRow = 1
    Dim Groups(1 To GroupsCount) As String
    Dim PrGroups(1 To GroupsCount) As String

    Sheets(

"data").Activate
    I = 2
    Do While True
        If GetCell(0, I).Value = "" Then Exit Do
        ' ...
        I = I + 1
    Loop
End Sub

Теперь надо заполнить массив Groups:

На месте многоточия

Dim I2 As Integer
For I2 = 1 To GroupsCount
    Groups(I2) = GetCell(I2, I)
Next I2
' ...
For I2 = 1 To GroupsCount ' VB не умеет копировать массивы
    PrGroups(I2) = Groups(I2)
Next I2
I =  I + 1

И создать заголовки:

На месте многоточия в предыдущем куске

For I2 = 1 To GroupsCount
    If Groups(I2) <> PrGroups(I2) Then
        Dim I3 As Integer
        For I3 = I2 To GroupsCount
            AddHeader I3, Groups(I3)
        Next I3
        Exit For
    End If
Next I2

Не забудем про процедуру AddHeader:

Перед FormatPrice

Sub AddHeader(Ty As Integer, Name As String)
    GetCellS("result", 1, CurRow).Value = Name
    CurRow = CurRow + 1
End Sub

Теперь надо перенести всякую информацию в result

For I2 = 0 To DataCount - 1
    GetCellS("result", I2, CurRow).Value = GetCell(I2, I)
Next I2

Подогнать столбцы по ширине и выбрать лист result для показа результата

После цикла в конце FormatPrice

Sheets("Result").Activate
Columns.AutoFit

Всё. Можно любоваться первой версией.

Некрасиво, но похоже. Давайте разбираться с форматированием. Сначала изменим процедуру AddHeader:

Sub AddHeader(Ty As Integer, Name As String)
    Sheets("result").Range("A" + CStr(CurRow) + ":C" + CStr(CurRow)).Merge
    ' Чтобы не заводить переменную и не писать каждый раз длинный вызов
    ' можно воспользоваться блоком With
    With GetCellS("result", 0, CurRow)
        .Value = Name
        .Font.Italic = True
        .Font.Name = "Cambria"
        Select Case Ty
        Case 1 ' Тип
            .Font.Bold = True
            .Font.Size = 16
        Case 2 ' Производитель
            .Font.Size = 12
        End Select
        .HorizontalAlignment = xlCenter
    End With
    CurRow = CurRow + 1
End Sub

Уже лучше:

Осталось только сделать границы. Тут уже нам требуется работать со всеми объединёнными ячейками, иначе бордюр будет только у одной:

Поэтому чуть-чуть меняем код с добавлением стиля границ:

Sub AddHeader(Ty As Integer, Name As String)
    With Sheets("result").Range("A" + CStr(CurRow) + ":C" + CStr(CurRow))
        .Merge
        .Value = Name
        .Font.Italic = True
        .Font.Name = "Cambria"
        .HorizontalAlignment = xlCenterSelect Case Ty
        Case 1 ' Тип
            .Font.Bold = True
            .Font.Size = 16
            .Borders(xlTop).Weight = xlThick
        Case 2 ' Производитель
            .Font.Size = 12
            .Borders(xlTop).Weight = xlMedium
        End Select
        .Borders(xlBottom).Weight = xlMedium ' По убыванию: xlThick, xlMedium, xlThin, xlHairline
    End With
    CurRow = CurRow + 1
End Sub

Осталось лишь добится пропусков перед началом новой группы. Это легко:

В начале FormatPrice

Dim I As Integer ' строка в  data
CurRow = 0 ' чтобы не было пропуска в самом начале
Dim Groups(1 To GroupsCount) As String

В цикле расстановки заголовков

If Groups(I2) <> PrGroups(I2) Then
    CurRow = CurRow + 1
    Dim I3 As Integer

В точности то, что и хотели.

Надеюсь, что эта статья помогла вам немного освоится с программированием для Excel на VBA. Домашнее задание — добавить заголовки «ID, Название, Цена» в результат. Подсказка: CurRow = 0 CurRow = 1.

Файл можно скачать тут (min.us) или тут (Dropbox). Не забудьте разрешить исполнение макросов. Если кто-нибудь подскажет человеческих файлохостинг, залью туда.

Спасибо за внимание.

Буду рад конструктивной критике в комментариях.

UPD: Перезалил пример на Dropbox и min.us.

UPD2: На самом деле, при вызове процедуры с одним параметром скобки можно поставить. Либо использовать конструкцию Call Foo(«bar», 1, 2, 3) — тут скобки нужны постоянно.

Свойства ячейки, часто используемые в коде VBA Excel. Демонстрация свойств ячейки, как структурной единицы объекта Range, на простых примерах.

Объект Range в VBA Excel представляет диапазон ячеек. Он (объект Range) может описывать любой диапазон, начиная от одной ячейки и заканчивая сразу всеми ячейками рабочего листа.

Примеры диапазонов:

• Одна ячейка – Range("A1").
• Девять ячеек – Range("A1:С3").
• Весь рабочий лист в Excel 2016 – Range("1:1048576").

Для справки: выражение Range("1:1048576") описывает диапазон с 1 по 1048576 строку, где число 1048576 – это номер последней строки на рабочем листе Excel 2016.

В VBA Excel есть свойство Cells объекта Range, которое позволяет обратиться к одной ячейке в указанном диапазоне (возвращает объект Range в виде одной ячейки). Если в коде используется свойство Cells без указания диапазона, значит оно относится ко всему диапазону активного рабочего листа.

Примеры обращения к одной ячейке:

• Cells(1000), где 1000 – порядковый номер ячейки на рабочем листе, возвращает ячейку «ALL1».
• Cells(50, 20), где 50 – номер строки рабочего листа, а 20 – номер столбца, возвращает ячейку «T50».
• Range("A1:C3").Cells(6), где «A1:C3» – заданный диапазон, а 6 – порядковый номер ячейки в этом диапазоне, возвращает ячейку «C2».

Для справки: порядковый номер ячейки в диапазоне считается построчно слева направо с перемещением к следующей строке сверху вниз.

Подробнее о том, как обратиться к ячейке, смотрите в статье: Ячейки (обращение, запись, чтение, очистка).

В этой статье мы рассмотрим свойства объекта Range, применимые, в том числе, к диапазону, состоящему из одной ячейки.

Еще надо добавить, что свойства и методы объектов отделяются от объектов точкой, как в третьем примере обращения к одной ячейке: Range("A1:C3").Cells(6).

Свойства ячейки (объекта Range)

Свойство	Описание
Address	Возвращает адрес ячейки (диапазона).
Borders	Возвращает коллекцию Borders, представляющую границы ячейки (диапазона). Подробнее…
Cells	Возвращает объект Range, представляющий коллекцию всех ячеек заданного диапазона. Указав номер строки и номер столбца или порядковый номер ячейки в диапазоне, мы получаем конкретную ячейку. Подробнее…
Characters	Возвращает подстроку в размере указанного количества символов из текста, содержащегося в ячейке. Подробнее…
Column	Возвращает номер столбца ячейки (первого столбца диапазона). Подробнее…
ColumnWidth	Возвращает или задает ширину ячейки в пунктах (ширину всех столбцов в указанном диапазоне).
Comment	Возвращает комментарий, связанный с ячейкой (с левой верхней ячейкой диапазона).
CurrentRegion	Возвращает прямоугольный диапазон, ограниченный пустыми строками и столбцами. Очень полезное свойство для возвращения рабочей таблицы, а также определения номера последней заполненной строки.
EntireColumn	Возвращает весь столбец (столбцы), в котором содержится ячейка (диапазон). Диапазон может содержаться и в одном столбце, например, Range("A1:A20").
EntireRow	Возвращает всю строку (строки), в которой содержится ячейка (диапазон). Диапазон может содержаться и в одной строке, например, Range("A2:H2").
Font	Возвращает объект Font, представляющий шрифт указанного объекта. Подробнее о цвете шрифта…
HorizontalAlignment	Возвращает или задает значение горизонтального выравнивания содержимого ячейки (диапазона). Подробнее…
Interior	Возвращает объект Interior, представляющий внутреннюю область ячейки (диапазона). Применяется, главным образом, для возвращения или назначения цвета заливки (фона) ячейки (диапазона). Подробнее…
Name	Возвращает или задает имя ячейки (диапазона).
NumberFormat	Возвращает или задает код числового формата для ячейки (диапазона). Примеры кодов числовых форматов можно посмотреть, открыв для любой ячейки на рабочем листе Excel диалоговое окно «Формат ячеек», на вкладке «(все форматы)». Свойство NumberFormat диапазона возвращает значение NULL, за исключением тех случаев, когда все ячейки в диапазоне имеют одинаковый числовой формат. Если нужно присвоить ячейке текстовый формат, записывается так: Range("A1").NumberFormat = "@". Общий формат: Range("A1").NumberFormat = "General".
Offset	Возвращает объект Range, смещенный относительно первоначального диапазона на указанное количество строк и столбцов. Подробнее…
Resize	Изменяет размер первоначального диапазона до указанного количества строк и столбцов. Строки добавляются или удаляются снизу, столбцы – справа. Подробнее…
Row	Возвращает номер строки ячейки (первой строки диапазона). Подробнее…
RowHeight	Возвращает или задает высоту ячейки в пунктах (высоту всех строк в указанном диапазоне).
Text	Возвращает форматированный текст, содержащийся в ячейке. Свойство Text диапазона возвращает значение NULL, за исключением тех случаев, когда все ячейки в диапазоне имеют одинаковое содержимое и один формат. Предназначено только для чтения. Подробнее…
Value	Возвращает или задает значение ячейки, в том числе с отображением значений в формате Currency и Date. Тип данных Variant. Value является свойством ячейки по умолчанию, поэтому в коде его можно не указывать.
Value2	Возвращает или задает значение ячейки. Тип данных Variant. Значения в формате Currency и Date будут отображены в виде чисел с типом данных Double.
VerticalAlignment	Возвращает или задает значение вертикального выравнивания содержимого ячейки (диапазона). Подробнее…

В таблице представлены не все свойства объекта Range. С полным списком вы можете ознакомиться не сайте разработчика.

Простые примеры для начинающих

Вы можете скопировать примеры кода VBA Excel в стандартный модуль и запустить их на выполнение. Как создать стандартный модуль и запустить процедуру на выполнение, смотрите в статье VBA Excel. Начинаем программировать с нуля.

Учтите, что в одном программном модуле у всех процедур должны быть разные имена. Если вы уже копировали в модуль подпрограммы с именами Primer1, Primer2 и т.д., удалите их или создайте еще один стандартный модуль.

Форматирование ячеек

Заливка ячейки фоном, изменение высоты строки, запись в ячейки текста, автоподбор ширины столбца, выравнивание текста в ячейке и выделение его цветом, добавление границ к ячейкам, очистка содержимого и форматирования ячеек.

Если вы запустите эту процедуру, информационное окно MsgBox будет прерывать выполнение программы и сообщать о том, что произойдет дальше, после его закрытия.

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38

Sub Primer1() MsgBox «Зальем ячейку A1 зеленым цветом и запишем в ячейку B1 текст: «Ячейка A1 зеленая!»» Range(«A1»).Interior.Color = vbGreen Range(«B1»).Value = «Ячейка A1 зеленая!» MsgBox «Сделаем высоту строки, в которой находится ячейка A2, в 2 раза больше высоты ячейки A1, « _ & «а в ячейку B1 вставим текст: «Наша строка стала в 2 раза выше первой строки!»» Range(«A2»).RowHeight = Range(«A1»).RowHeight * 2 Range(«B2»).Value = «Наша строка стала в 2 раза выше первой строки!» MsgBox «Запишем в ячейку A3 высоту 2 строки, а в ячейку B3 вставим текст: «Такова высота второй строки!»» Range(«A3»).Value = Range(«A2»).RowHeight Range(«B3»).Value = «Такова высота второй строки!» MsgBox «Применим к столбцу, в котором содержится ячейка B1, метод AutoFit для автоподбора ширины» Range(«B1»).EntireColumn.AutoFit MsgBox «Выделим текст в ячейке B2 красным цветом и выровним его по центру (по вертикали)» Range(«B2»).Font.Color = vbRed Range(«B2»).VerticalAlignment = xlCenter MsgBox «Добавим к ячейкам диапазона A1:B3 границы» Range(«A1:B3»).Borders.LineStyle = True MsgBox «Сделаем границы ячеек в диапазоне A1:B3 двойными» Range(«A1:B3»).Borders.LineStyle = xlDouble MsgBox «Очистим ячейки диапазона A1:B3 от заливки, выравнивания, границ и содержимого» Range(«A1:B3»).Clear MsgBox «Присвоим высоте второй строки высоту первой, а ширине второго столбца — ширину первого» Range(«A2»).RowHeight = Range(«A1»).RowHeight Range(«B1»).ColumnWidth = Range(«A1»).ColumnWidth MsgBox «Демонстрация форматирования ячеек закончена!» End Sub

Вычисления в ячейках (свойство Value)

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

Обратите внимание, что разделителем дробной части у чисел в VBA Excel является точка, а не запятая.

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24

Sub Primer2() MsgBox «Запишем в ячейку A1 число 25.3, а в ячейку B1 — число 34.42» Range(«A1»).Value = 25.3 Range(«B1»).Value = 34.42 MsgBox «Запишем в ячейку C1 произведение чисел, содержащихся в ячейках A1 и B1» Range(«C1»).Value = Range(«A1»).Value * Range(«B1»).Value MsgBox «Запишем в ячейку D1 формулу, которая перемножает числа в ячейках A1 и B1» Range(«D1»).Value = «=A1*B1» MsgBox «Заменим содержимое ячеек A1 и B1 на числа 6.258 и 54.1, а также активируем ячейку D1» Range(«A1»).Value = 6.258 Range(«B1»).Value = 54.1 Range(«D1»).Activate MsgBox «Мы видим, что в ячейке D1 произведение изменилось, а в строке состояния отображается формула; « _ & «следующим шагом очищаем задействованные ячейки» Range(«A1:D1»).Clear MsgBox «Демонстрация вычислений в ячейках завершена!» End Sub

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

Различие свойств Text, Value и Value2

Построение с помощью кода VBA Excel таблицы с результатами сравнения того, как свойства Text, Value и Value2 возвращают число, дату и текст.

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56

Sub Primer3() ‘Присваиваем ячейкам всей таблицы общий формат на тот ‘случай, если формат отдельных ячеек ранее менялся Range(«A1:E4»).NumberFormat = «General» ‘добавляем сетку (границы ячеек) Range(«A1:E4»).Borders.LineStyle = True ‘Создаем строку заголовков Range(«A1») = «Значение» Range(«B1») = «Код формата» ‘формат соседней ячейки в столбце A Range(«C1») = «Свойство Text» Range(«D1») = «Свойство Value» Range(«E1») = «Свойство Value2» ‘Назначаем строке заголовков жирный шрифт Range(«A1:E1»).Font.Bold = True ‘Задаем форматы ячейкам A2, A3 и A4 ‘Ячейка A2 — числовой формат с разделителем триад и двумя знаками после запятой ‘Ячейка A3 — формат даты «ДД.ММ.ГГГГ» ‘Ячейка A4 — текстовый формат Range(«A2»).NumberFormat = «# ##0.00» Range(«A3»).NumberFormat = «dd.mm.yyyy» Range(«A4»).NumberFormat = «@» ‘Заполняем ячейки A2, A3 и A4 значениями Range(«A2») = 2362.4568 Range(«A3») = CDate(«01.01.2021») ‘Функция CDate преобразует текстовый аргумент в формат даты Range(«A4») = «Озеро Байкал» ‘Заполняем ячейки B2, B3 и B4 кодами форматов соседних ячеек в столбце A Range(«B2») = Range(«A2»).NumberFormat Range(«B3») = Range(«A3»).NumberFormat Range(«B4») = Range(«A4»).NumberFormat ‘Присваиваем ячейкам C2-C4 значения свойств Text ячеек A2-A4 Range(«C2») = Range(«A2»).Text Range(«C3») = Range(«A3»).Text Range(«C4») = Range(«A4»).Text ‘Присваиваем ячейкам D2-D4 значения свойств Value ячеек A2-A4 Range(«D2») = Range(«A2»).Value Range(«D3») = Range(«A3»).Value Range(«D4») = Range(«A4»).Value ‘Присваиваем ячейкам E2-E4 значения свойств Value2 ячеек A2-A4 Range(«E2») = Range(«A2»).Value2 Range(«E3») = Range(«A3»).Value2 Range(«E4») = Range(«A4»).Value2 ‘Применяем к таблице автоподбор ширины столбцов Range(«A1:E4»).EntireColumn.AutoFit End Sub

Результат работы кода:

В таблице наглядно видна разница между свойствами Text, Value и Value2 при применении их к ячейкам с отформатированным числом и датой. Свойство Text еще отличается от Value и Value2 тем, что оно предназначено только для чтения.

---

Функция FilenamesCollection предназначена для получения списка файлов из папки, с учётом выбранной глубины поиска в подпапках. Используется рекурсивный перебор папок, до заданного уровня вложенности. В процессе перебора папок, пути у найденным файлам помещаются в коллекцию (объект типа Collection) для последующего перебора. К статье прикреплено 2 примера файла с макросами на основе этой функции: Читать далее 301923 просмотра 2 прикреплённых файла Надстройка samradDatePicker (русифицированная) для облегчения ввода даты в ячейки листа Excel. Добавляет в контекстное меня ячеек пункт выбора даты, а при выделении ячеек, содержащих дату, справа от ячейки отображает значок календаря. Поместите файл надстройки из вложения в папку автозагрузки Excel (C:Program FilesMicrosoft OfficeOFFICExxXLSTART). В контекстном меню ячеек появляется новый пункт — «Выбрать дату из календаря«. Рядом с ячейками, в которые уже введена дата, будет отображаться маленький календарик, щелчок по которому вызовет большой календарь — для выбора даты. Читать далее 290076 просмотров 2 прикреплённых файла Требуется макросом поместить изображение (картинку) на лист Excel? Используйте функцию ВставитьКартинку, которая позволит вам вставить картинку в выбранную ячейку (или диапазон ячеек). При вызове функции можно задать дополнительные дополнительные параметры, указав, следует ли подгонять картинку (или ячейку) по высоте и ширине. В этом примере демонстрируются возможные варианты применения функции вставки картинок: Читать далее 237290 просмотров макрос удалит на листе все строки, в которых содержится искомый текст: (пример — во вложении ConditionalRowsDeleting.xls) Sub УдалениеСтрокПоУсловию() Dim ra As Range, delra As Range, ТекстДляПоиска As String Application.ScreenUpdating = False ' отключаем обновление экрана ТекстДляПоиска = "Наименование ценности" ' удаляем строки с таким текстом ' перебираем все строки в используемом диапазоне листа For Each ra In ActiveSheet.UsedRange.Rows Читать далее 234932 просмотра 2 прикреплённых файла Функции GetFileName и GetFilePath по сути аналогичны, и предназначены для вывода диалогового окна выбора файла (при этом можно указать стартовую папку для поиска файла, и тип/расширение выбираемого файла) Функция GetFilenamesCollection позволяет выборать сразу несколько файлов в одной папке. Функция GetFolderPath работает также, только служит для вывода диалогового окна выбора папки. Читать далее 214486 просмотров