ПРИМЕРЫ_1 ПРОЦЕДУР VBA В MICROSOFT EXCEL

ПРИМЕРЫ ПРОЦЕДУР VBA В MICROSOFT EXCEL

Sub Index_Of_Color() ' Распечатка на экран применяемых цветов и их номеров

Dim i As Integer, YesNo As Variant For i = 1 To 56

Cells(i, 1).Interior.ColorIndex = i Next

YesNo = MsgBox("Номер строки соответствует номеру в операторе Color" & Chr(10) & "Очистить столбик?", vbYesNo) ' = vbYes

If YesNo = 6 Then

Sheets("Лист1").Columns("A").Clear

End If

End Sub

__________________________________________________________________________

Sub Копирование_столб()

Sheets("Лист1").Select 'Переход на Лист1

Sheets("Лист1").Columns("E").Copy Sheets("Лист2").Columns("B") 'Копирует столбец Е листа 1 на столбец В листа 2

Sheets("Лист2").Select 'Переход на Лист2

MsgBox ("Столбец скопирован с Лист1 в Лист2" & "Стираем столбец")

Sheets("Лист2").Columns("B").Clear 'Очищает столбец В листа 2

End Sub

__________________________________________________________________________

Sub Копирование_диапазон()

Sheets("Лист1").Select 'Переход на Лист1

Sheets("Лист1").Rows("1:10").Copy Sheets("Лист2").Rows("1:10") 'Копирует столбец Е листа 1 на столбец В листа 2

Sheets("Лист2").Select 'Переход на Лист2

MsgBox ("Столбец скопирован с Лист1 в Лист2" & "Стираем столбец")

Sheets("Лист2").Rows("1:10").Clear 'Очищает столбец В листа 2

End Sub

__________________________________________________________________________

ПРИМЕРЫ ПРОЦЕДУР VBA В MICROSOFT EXCEL

Sub Копирование_заданного_диапазон()

' Копирование диапазона ячеек

Dim first As String, second As String

Dim diapazon As String

first = InputBox("Введите номер первой ячейки. Например A1")

second = InputBox("Введите номер последней ячейки. Например E2")

diapazon = (first) + (":") + (second) 'Создаёт переменную диапазона ячеек

Sheets("лист1").Select 'Переход на лист 1

Range(diapazon).Select ' Переход в диапазон ячеек

Selection.Copy 'Копирование выделенного диапазона

Sheets("лист2").Select 'Переход на лист 2

Range(first).Select 'Выделение первой ячейки диапазона

Selection.PasteSpecial Paste:=xlPasteValues 'Вставка содержимого буфера обмена

End Sub

__________________________________________________________________________

Sub Подсчёт_литов_книги()

Dim Tab_1, Book_1, Sheet_1 As Object Dim NLists As Integer, Name_1 As String

Name_1 = InputBox("Введите путь и полное имя файла", , Name_1) Set Tab_1 = CreateObject("Excel.Application") 'Открывает таблицу

Set Book_1 = Tab_1.Workbooks.Open(Name_1) 'Загружает файл по адресу Name_1

NLists = Sheets.Count 'Подсчитывает количество листов в книге

MsgBox ("Количество листов в книге " & NLists)

End Sub

__________________________________________________________________________

Sub Создать_Лист_Excel()

Sheets("Лист1").Select 'Переход на Лист1

Worksheets.Add.Name = "Первая проба" 'Добавляет лист в книгу

'Sheets.Add Before:=Sheets("Лист1"): ActiveSheet.Name = "Первая проба"

MsgBox ("Создан лист - Первая проба")

Worksheets("Первая проба").Delete 'Удаляет лист из книги

MsgBox ("Удалён лист - Первая проба")

End Sub