Главная страница
Навигация по странице:

  • File - Close and return to Microsoft Excel

  • Готовые макросы в VBA Excel, Миронов. Готовые макросы в vba excel, Миронов Глава Макросы 9


    Скачать 1.35 Mb.
    НазваниеГотовые макросы в vba excel, Миронов Глава Макросы 9
    Дата23.01.2019
    Размер1.35 Mb.
    Формат файлаdoc
    Имя файлаГотовые макросы в VBA Excel, Миронов.doc
    ТипДокументы
    #64865
    страница23 из 47
    1   ...   19   20   21   22   23   24   25   26   ...   47

    Сдвиг от выделенной ячейки


    Sub Test()

    Dim cur_range As Range

    Set cur_range = Range("A1")

    Set cur_range = cur_range.Offset(1, 0)

    Debug.Print cur_range.Address

    End Sub

    Перебор ячеек вниз по колонне


    Sub beg()

    Dim a As Boolean

    Dim d As Double

    Dim c As Range

    a = False

    Set c = Range(ActiveCell.Address)

    c.Select

    d = c.Value

    c.Value = d

    While (a = False)

    ActiveCell.Offset(1, 0).Select

    If (IsEmpty(ActiveCell.Value) = False) Then

    Set c = Range(ActiveCell.Address)

    c.Select

    d = c.Value

    c.Value = d

    Else

    a = False

    End If

    Wend

    End Sub

    Создание заливки диапазона


    Sub FillRange()

    ' Заливка диапазона

    With Range("B1:E10")

    ' Задаем узор - сетчатый

    .Interior.Pattern = xlPatternChecker

    ' Цвет узора - синий

    .Interior.PatternColor = RGB(0, 0, 255)

    ' Цвет ячейки - красный

    .Interior.Color = RGB(255, 0, 0)

    End With

    End Sub

    Подбор параметра ячейки


    Sub Макрос1()

    ' Сочетание клавиш: Ctrl+ф

    Range("G5").GoalSeek Goal:=4, ChangingCell:=Range("G4")

    End Sub

    Разбиение диапазона


    Function ExtractElement(Txt, n, Separator) As String
    '   Функция выдает n-ый элемент текстовой строки Txt, где
    '   символ Separator используется как разделитель

     

        Dim Txt1 As String, TempElement As String
        Dim ElementCount As Integer, i As Integer
       
        Txt1 = Txt
    '   Если в качестве разделителя используется пробел, то убираем лишние

    '   и двойные пробелы
        If Separator = Chr(32) Then Txt1 = Application.Trim(Txt1)
       
    '   Добавляем разделитель в конец строки (если необходимо)
        If Right(Txt1, 1) <> Separator Then Txt1 = Txt1 & Separator
       
    '   Начальные значения
        ElementCount = 0
        TempElement = ""
       
    '   Извлекаем элемент

        For i = 1 To Len(Txt1)
            If Mid(Txt1, i, 1) = Separator Then
                ElementCount = ElementCount + 1
                If ElementCount = n Then
    '               Found it, so exit
                    ExtractElement = TempElement
                    Exit Function
                Else
                    TempElement = ""
                End If
            Else
                TempElement = TempElement & Mid(Txt1, i, 1)
            End If
        Next i
        ExtractElement = ""
    End Function

    Закройте редактор и вернитесь в Excel командой File - Close and return to Microsoft Excel.

    Теперь в любой ячейке листа Вы можете использовать эту функцию через меню Вставка - Функция - категория Определенные пользователем, где в аргументах:

    • Txt - ячейка с текстом, который надо разделить,

    • n - порядковый номер извлекаемого элемента,

    • Separator - символ-разделитель.

    Объединение данных диапазона


    Function Couple(Diapazon)

    ' Объединение данных, содержащихся в ячейках диапазона _

    Diapazon (разделитель между значениями - пробел)

    ' iCell - текущая ячейка

    For Each iCell In Diapazon

    ' Сцепляются данные только заполненных ячеек

    If IsEmpty(iCell) <> True Then

    ' Добавление значения ячейки в выходную строку

    If Couple = "" Then

    Couple = iCell

    Else

    Couple = Couple & " " & iCell

    End If

    End If

    Next

    End Function

    Объединение данных диапазона_2


    Function CoupleFormat(Diapazon)

    ' Объединение текстовых данных, содержащихся в ячейках _

    диапазона Diapazon (разделитель между значениями - пробел)

    ' iCell - текущая ячейка

    For Each iCell In Diapazon

    ' Сцепляются данные только заполненных ячеек

    If IsEmpty(iCell) <> True Then

    ' Добавление текста ячейки в выходную строку

    If CoupleFormat = "" Then

    CoupleFormat = iCell.Text

    Else

    CoupleFormat = CoupleFormat & " " & iCell.Text

    End If

    End If

    Next

    End Function
    1   ...   19   20   21   22   23   24   25   26   ...   47


    написать администратору сайта