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

• Название: Готовые макросы в vba excel, Миронов Глава Макросы 9
• Дата: 06.02.2018
• Размер: 1.35 Mb.
• Имя файла: 33980_7d1642e70814394f108d07a8a2edd23e.doc
• Тип: Документы; #35930
• страница: 23 из 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