Макросы (стр. 1 )

Глава 1. Макросы.. 8

Запуск макроса с поиском ячейки. 8

Запуск макроса при открытии книги. 8

Запуск макроса при вводе в ячейку «2». 8

Запуск макроса при нажатии «Ентер». 9

Добавить в панель свою вкладку «Надстройки» (Формат ячейки) 9

Глава 2. Работа с файлами (т. е.обмен данными с ТХТ, RTF, XLS и т. д.) 11

Проверка наличия файла по указанному пути_1. 11

Проверка наличия файла по указанному пути_2. 11

Проверка наличия файла по указанному пути_3. 11

Поиск нужного файла_1. 12

Поиск нужного файла_2. 12

Поиск нужного файла_3. 13

Поиск нужного файла_4. 13

Автоматизация удаления файлов. 13

Произвольный текст в строке состояния. 14

Восстановление строки состояния. 14

Бегущая строка в строке состояния. 14

Быстрое изменение заголовка окна. 14

Быстрое изменение заголовка окна_2. 14

Изменение заголовка окна (со скрытием названия файла) 14

Возврат к первоначальному заголовку. 15

Что открыто в данный момент. 15

Работа с текстовыми файлами. 15

Запись и чтение текстового файла. 15

Обработка нескольких текстовых файлов. 16

Определение конца строки текстового файла. 17

Копирование из текстового файла в эксель. 18

Копирование содержимого в текстовый файл_1. 18

Копирование содержимого в текстовый файл_2. 18

Экспорт данных в txt 18

Экспорт данных в html 20

Импорт данных, для которых нужно более 256 столбцов. 22

Создание резервных копий ценных файлов. 25

Подсчет количества открытий файла. 25

Вывод пути к файлу в активную ячейку. 26

Копирование содержимого файла RTF в эксель. 26

Копирование данных из закрытой книги. 27

Извлечение данных из закрытого файла. 27

Поиск слова в файлах. 28

Создание текстового файла и ввод текста в файл. 29

Создание текстового файла и ввод текста (определение конца файла) 30

Создание документов Word на основе таблицы Excel 30

Команды создания и удаления каталогов. 32

Получение текущего каталога. 32

Смена каталога. 32

Посмотреть все файлы в каталоге_1. 32

Посмотреть все файлы в каталоге_2. 33

Посмотреть все файлы в каталоге_3. 35

Глава 3. Рабочая область Microsoft Excel 37

Рабочая книга. 37

Количество имен рабочей книги. 37

Защита рабочей книги. 37

Запрет печати книги. 38

Открытие книги (или текстовых файлов) 38

Открытие книги и добавление в ячейку А1 текста. 38

Сколько книг открыто. 38

Закрытие всех книг. 39

Закрытие рабочей книги только при выполнении условия. 39

Сохранение рабочей книги с именем, представляющим собой текущую дату. 39

Сохранена ли рабочая книга. 39

Создать книгу с одним листом.. 39

Создать книгу. 39

Удаление ненужных имен. 40

Быстрое размножение рабочей книги. 40

Сортировка листов. 40

Поиск максимального значения на всех листах книги. 42

Рабочий лист. 43

Проверка наличия защиты рабочего листа. 43

Список отсортированных листов. 43

Создать новый лист_1. 45

Создать новый лист_2. 45

Удаление листов в зависимости от даты.. 45

Копирование листа в книге. 46

Копирование листа в новую книгу (создается) 46

Перемещение листа в книге. 46

Перемещение нескольких листов в новую книгу. 46

Заменить существующий файл. 46

«Перелистывание» книги. 46

Вставка колонтитула с именем книги, листа и текущей датой. 47

Существует ли лист. 47

Существует ли лист_2. 47

Вывод количества листов в активной книге. 48

Вывод количества листов в активной книге в виде гиперссылок. 48

Вывод имен активных листов по очереди. 48

Вывод имени и номеров листов текущей книги. 48

Сделать лист невидимым.. 49

Сколько страниц на всех листах?. 49

Ячейка и диапазон (столбцы и строки) 49

Копирование строк на другой лист. 49

Копирование столбцов на другой лист. 49

Подсчет количества ячеек, содержащих указанные значения_1. 50

Подсчет количества ячеек в диапазоне, содержащих указанные значения_2. 50

Подсчет количества видимых ячеек в диапазоне. 51

Определение количества ячеек в диапазоне и суммы их значений. 51

Подсчет количества ячеек. 51

Автоматический пересчет данных таблицы при изменении ее значений. 51

Ввод данных в ячейки. 53

Ввод данных с использованием формул. 53

Последовательный ввод данных. 53

Ввод текстоввых данных в ячейки. 53

Вывод в ячейки названия книги, листа и количества листов. 54

Удаление пустых строк_1. 54

Удаление пустых строк_2. 54

Удаление пустых строк_3. 55

Удаление строки по условию.. 55

Удаление скрытых строк. 56

Удаление используемых скрытых строк или строк с нулевой высотой. 56

Удаление дубликатов по маске. 56

Выделение диапазона над текущей ячейкой. 57

Выделение диапазона над текущей ячейкой_2. 57

Выделить ячейку и поместить туда число. 58

Выделение отрицательных значений. 58

Выделение диапазона и использование абсолютных адресов. 58

Выделение ячеек через интервал_1. 59

Выделение ячеек через интервал_2. 59

Выделение нескольких диапазонов. 60

Движение по ячейкам.. 60

Поиск ближайшей пустой ячейки столбца. 61

Поиск максимального значения. 61

Поиск и замена по шаблону. 61

Поиск значения с отображением результата в отдельном окне. 62

Поиск с выделением найденных данных_1. 62

Поиск с выделением найденных данных_2. 62

Поиск по условию в диапазоне. 63

Поиск последней непустой ячейки диапазона. 64

Поиск последней непустой ячейки столбца. 64

Поиск последней непустой ячейки строки. 64

Поиск ячейки синего цвета в диапазоне. 65

Поиск отрицательного значения в диапазоне и выделения синим цветом.. 65

Поиск наличия значения в столбце. 65

Поиск совпадений в диапазоне. 66

Поиск ячейки в диапазоне_1. 67

Поиск ячейки в диапазоне_2. 67

Поиск приближенного значения в диапазоне. 67

Поиск начала и окончания диапазона, содержащего данные. 68

Поиск начала данных. 68

Автоматическая замена значений. 68

Быстрое заполнение диапазона (массив) 69

Заполнение через интервал(массив) 69

Заполнение указанного диапазона(массив) 70

Заполнение диапазона(массив) 70

Расчет суммы первых значений диапазона. 71

Размещение в ячейке электронных часов. 72

«Будильник». 72

Оформление верхней и нижней границ диапазона. 72

Адрес активной ячейки. 73

Координаты активной ячейки. 73

Формула активной ячейки. 73

Получение из ячейки формулы.. 73

Тип данных ячейки. 73

Вывод адреса конца диапазона. 74

Получение информации о выделенном диапазоне. 74

Взять слово с 13 символа в ячейке. 76

Создание изменяемого списка (таблица) 77

Проверка на пустое значение. 77

Пересечение ячеек. 77

Умножение выделенного диапазона на 2. 77

Одновременное умножение всех данных диапазона. 78

Деление диапазона на 100. 78

Возведение каждой ячейки диапазона в квадрат. 78

Суммирование данных только видимых ячеек. 78

Сумма ячеек с числовыми значениями. 79

При суммировании — курсор внутри диапазона. 79

Начисление процентов в зависимости от суммы_1. 80

Начисление процентов в зависимости от суммы_2. 80

Начисление процентов в зависимости от суммы_3. 81

Сводный пример расчета комиссионного вознаграждения. 81

Движение по диапазону. 83

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

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

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

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

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

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

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

Узнать максимальную колонку или строку. 86

Ограничение возможных значений диапазона. 86

Тестирование скорости чтения и записи диапазонов. 88

Открыть MsgBox при выборе ячейки. 89

Скрытие строки. 89

Скрытие нескольких строк. 89

Скрытие столбца. 89

Скрытие нескольких столбцов. 89

Скрытие строки по имени ячейки. 89

Скрытие нескольких строк по адресам ячеек. 89

Скрытие столбца по имени ячейки. 89

Скрытие нескольких столбцов по адресам ячеек. 90

Мигание ячейки. 90

Глава 4. Работа с примечаниями. 91

Вывод на экран всех примечаний рабочего листа. 91

Функция извлечения комментария. 91

Список примечаний защищенных листов. 91

Перечень примечаний в отдельном списке_1. 92

Перечень примечаний в отдельном списке_2. 93

Перечень примечаний в отдельном списке_3. 93

Подсчет количества примечаний_1. 94

Подсчет количества примечаний_2. 95

Подсчет примечаний_3. 95

Выделение ячеек с примечаниями. 95

Отображение всех примечаний. 95

Изменение цвета примечаний. 96

Добавление примечаний. 96

Добавление примечаний в диапазон по условию.. 96

Перенос комментария в ячейку и обратно. 96

Перенос значений из ячейки в комментарий_1. 97

Перенос значений из ячейки в комментарий_2. 98

Глава. Пользовательские вкладки на ленте. 99

Дополнение панели инструментов. 99

Добавление кнопки на панель инструментов. 99

Панель с одной кнопкой. 99

Панель с двумя кнопками. 99

Создание панели справа. 100

Вызов предварительного просмотра. 100

Создание пользовательского меню (вариант

Создание пользовательского меню (вариант

Создание пользовательского меню (вариант

Создание пользовательского меню (вариант

Создание пользовательского меню (вариант

Создание пользовательского меню (вариант

Создание списка пунктов главного меню Excel 108

Создание списка пунктов контекстных меню.. 108

Отображение панели инструментов при определенном условии. 109

Скрытие и отображение панелей инструментов. 111

Создать подсказку к моим кнопкам.. 112

Создание меню на основе данных рабочего листа. 112

Создание контекстного меню.. 115

Блокировка контекстного меню.. 117

Добавление команды в меню Сервис. 118

Добавление команды в меню Вид. 119

Создание панели со списком.. 120

Мультфильм с помощником в главной роли. 122

Дополнение помощника текстом, заголовком, кнопкой и значком.. 123

Новые параметры помощника. 124

Использование помощника для выбора цвета заливки. 125

Глава. ДИАЛОГОВЫЕ ОКНА.. 127

Функция INPUTBOX (через ввод значения) 127

Вызов предварительного просмотра. 127

Настройка ввода данных в диалоговом окне. 127

Открытие диалогового окна (“Открыть файл”)_1. 128

Открытие диалогового окна (“Открыть файл”)_2. 128

Открытие диалогового окна (“Печать”) 128

Другие диалоговые окна. 128

Вызов броузера из Экселя. 129

Диалоговое окно ввода данных. 129

Диалоговое окно настройки шрифта. 129

Значения по умолчанию.. 129

Глава. Форматирование текста. Таблицы. ГРАНИЦЫ И ЗАЛИВКА. 130

Вывод списка доступных шрифтов. 130

Выбор из текста всех чисел. 130

Прописная буква только в начале текста. 131

Подсчет количества повторов искомого текста. 131

Выделение из текста произвольного элемента. 132

Отображение текста «задом наперед». 133

Англоязычный текст — заглавными буквами. 133

Запуск таблицы символов из Excel 134

глава информация о пользователе, компьютере, принтере и т. д. 136

Получить имя пользователя. 136

Вывод разрешения монитора. 137

Получение информации об используемом принтере. 137

Просмотр информации о дисках компьютера. 138

ГЛАВА. ЮЗЕРФОРМЫ

Глава. ДИАГРАММЫ

Построение диаграммы с помощью макроса. 142

Сохранение диаграммы в отдельном файле. 143

Построение и удаление диаграммы нажатием одной кнопки. 144

Вывод списка диаграмм в отдельном окне. 145

Применение случайной цветовой палитры.. 146

Эффект прозрачности диаграммы.. 146

Построение диаграммы на основе данных нескольких рабочих листов. 148

Создание подписей к данным диаграммы.. 150

ГлаВА. РАЗНЫЕ ПРОГРАММЫ. 151

Программа для составления кроссвордов. 151

Создать обложку DVD.. 155

Игра «Минное поле». 156

Игра «Угадай животное». 158

Расчет на основании ячеек определенного цвета. 161

ГЛАВА. ДРУГИЕ ФУНКЦИИ И МАКРОСЫ

Вызов функциональных клавиш.. 175

Расчет среднего арифметического значения. 175

Перевод чисел в «деньги». 175

Поиск ближайшего понедельника. 176

Подсчет количества полных лет. 177

Расчет средневзвешенного значения. 177

Преобразование номера месяца в его название. 178

Использование относительных ссылок. 178

Преобразование таблицы Excel в HTML-формат. 179

Генератор случайных чисел. 181

Случайные числа — на основании диапазона. 182

Применение функции без ввода ее в ячейку. 183

Подсчет именованных объектов. 183

Включение автофильтра с помощью макроса. 183

Создание бегущей строки. 183

Создание бегущей картинки. 184

Вращающиеся автофигуры.. 185

Вызов таблицы цветов. 187

Создание калькулятора. 188

Склонение фамилии, имени и отчества. 188

ГЛАВА. ДАТА И ВРЕМЯ.. 194

Вывод даты и времени_1. 194

Вывод даты и времени_2. 194

Получение системной даты.. 195

Извлечение даты и часов. 195

Функция ДатаПолная. 195

Глава 1. Макросы

Запуск макроса с поиском ячейки

' Sub GotoFixedCell:

' Делает активной ячейку, содержащую значение vVariant на

' рабочем листе sSheetName в активной рабочей книге.

'

' Note: Содержимое ячеек интерпретируется как 'значение'!

'

Public Sub GotoFixedCell(vValue As Variant, sSheetName As String)

Dim c As Range, cStart As Range, cForFind As Range

Dim i As Integer

On Error GoTo errhandle:

Set cForFind = Worksheets(sSheetName).Cells ' Диапазон поиска

With cForFind

Set c = .Find(What:=vValue, After:=ActiveCell, LookIn:=xlValues, _

LookAt:= xlРart, SearchOrder:=xlByRows,_

SearchDirection:=xlNext, MatchCase:=False)

Set cStart = c

While Not c Is Nothing

Set c = .FindNext(c)

If c. Address = cStart. Address Then

c. Select

Exit Sub

End If

Wend

End With

Exit Sub

errНandle:

MsgBox Err. Descriрtion, vbExclamation, "Error #" & Err. Number

End Sub

Запуск макроса при открытии книги

Sub Auto_Oрen()

Запуск макроса при вводе в ячейку «2»

Private Sub Worksheet_Change(ByVal Target As Range)

Dim w As Object

'On Error Resume Next

If Range("A1").Value = 2 Then

MsgBox "Ох! Значение ячейки стало равным 2-м!"

MsgBox "Я попробую сейчас открыть модуль с процедурой, которая все это делает!"

Application. VBE. MainWindow. SetFocus

Application. VBE. Windows(1).SetFocus

SendKeys "{F7}", True

End If

End Sub

Запуск макроса при нажатии «Ентер»

в модуле листа

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application. OnKey "{~}", "StartEnter"

End Sub

в модуле книги

Sub StartEnter()

MsgBox ("sadfsdfsf")

End Sub

Добавить в панель свою вкладку «Надстройки» (Формат ячейки)

Код в модуле рабочего листа

Sub Worksheet_Change(ByVal Target As Excel. Range)

Call UpdateToolbar

End Sub

Sub Worksheet_SelectionChange(ByVal Target As Excel. Range)

Call UpdateToolbar

End Sub

Листинг 2.43. Код в стандартном модуле

Sub FastChangeNumberFormat()

Dim bar As CommandBar

Dim button As CommandBarButton

' Удаление существующей панели инструментов (если она есть)

On Error Resume Next

CommandBars("Числовой формат").Delete

On Error GoTo 0

' Формирование новой панели

Set bar = CommandBars. Add

With bar

.Name = "Числовой формат"

.Visible = True

End With

' Создание кнопки

Set button = CommandBars("Числовой формат").Controls. Add _

(Type:=msoControlButton)

With button

.Caption = ""

.OnAction = "ChangeNumFormat"

.TooltipText = "Щелкните для изменения числового формата"

.Style = msoButtonCaption

End With

' Обновление созданной панели инструментов

Call UpdateToolbar

End Sub

Sub UpdateToolbar()

' Обновление панели инструментов (если она создана)

On Error Resume Next

' Изменение заголовка кнопки (на название формата выделенной ячейки)

CommandBars("Числовой формат").Controls(1).Caption = _

ActiveCell. NumberFormat

End Sub

Sub ChangeNumFormat()

' Отображение диалогового окна изменения формата ячейки

Application. Dialogs(xlDialogFormatNumber).Show

Call UpdateToolbar

End Sub

Глава 2. Работа с файлами (т. е.обмен данными с ТХТ, RTF, XLS и т. д.)

Проверка наличия файла по указанному пути_1

Sub VerifyFileLocation()

Dim strFileName As String

Dim strFileTitle As String

' Имя и путь искомого файла

strFileTitle = "primer. xls"

strFileName = "C:\Документы\primer. xls"

' Проверка наличия файла (функция Dir возвращает пустую _

строку, если по указанному пути файл обнаружить не удалось)

If Dir(strFileName) <> "" Then

MsgBox "Файл " & strFileTitle & " найден"

Else

MsgBox "Файл " & strFileTitle & " не найден"

End If

End Sub

Проверка наличия файла по указанному пути_2

Sub VerifyFileLocation1()

Dim strFileName As String

' Имя искомого файла

strFileName = "C:\Документы\primer. xls"

' Проверка наличия файла (функция Dir возвращает пустую _

строку, если по указанному пути файл обнаружить не удалось)

If Dir(strFileName) <> "" Then

MsgBox "Файл " & strFileName & " найден"

Else

MsgBox "Файл " & strFileName & " не найден"

End If

End Sub

Проверка наличия файла по указанному пути_3

Sub Check_Disk()

On Error Resume Next

If Dir("\\192.168.1.200\c\", vbSystem) <> "" Then

If Err = 52 Then

Err. Clear

MsgBox "Диска нет!", 48, "Ошибка"

Exit Sub

End If

If Err <> 0 Then

MsgBox "Произошло ошибка!", 48, "Ошибка"

Exit Sub

Else

On Error GoTo 0

MsgBox "Диск есть!", 64, ""

End If

End If

End Sub

Поиск нужного файла_1

Sub FileSearch()

Dim strFileName As String

Dim strFolder As String

Dim strFullPath As String

' Задание имени папки для поиска

strFolder = InputBox("Определите папку:")

If strFolder = "" Then Exit Sub

' Задание имени файла для поиска

strFileName = Application. InputBox("Введите имя файла:")

If strFileName = "" Then Exit Sub

' При необходимости дополняем имя папки "\"

If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\"

' Полный путь файла

strFullPath = strFolder & strFileName

' Вывод окна с отчетом о поиске средствами VBA

MsgBox "Использование команды VBA..." & vbCrLf & vbCrLf & _

dhSearchVBA(strFullPath), vbInformation, strFullPath

' Вывод окна с отчетом о поиске средствами объекта FileSearch

MsgBox "Использование объекта FileSearch..." & vbCrLf & _

vbCrLf & dhSearchFileSearch(strFolder, strFileName), vbInformation, _

strFullPath

' Вывод окна с отчетом о поиске средствами объекта _

FileSystemObject

MsgBox "Использование объекта FileSystemObject..." & vbCrLf & _

vbCrLf & dhSearchFileSystemObject(strFullPath), vbInformation, _

strFullPath

End Sub

Поиск нужного файла_2

Function dhSearchVBA(varFullPath As Variant) As Boolean

' Использование команды VBA

dhSearchVBA = Dir(varFullPath) <> ""

End Function

Поиск нужного файла_3

Function dhSearchFileSearch(varFolder As Variant, varFileName _

As Variant) As Boolean

' Использование объекта FileSearch

With Application. FileSearch

' Создание нового поиска

.NewSearch

' Имя для поиска

.FileName = varFileName

' Папка поиска

.LookIn = varFolder

' Собственно поиск

.Execute

dhSearchFileSearch = .FoundFiles. Count <> 0

End With

End Function

Поиск нужного файла_4

Function dhSearchFileSystemObject(varFullPath As Variant) As Boolean

Dim objFSObject As Object

' Использование объекта FileSystemObject

Set objFSObject = CreateObject("Scripting. FileSystemObject")

dhSearchFileSystemObject = objFSObject. FileExists(varFullPath)

End Function

Автоматизация удаления файлов

Листинг 3.51. Удаление файла

Sub DeleteFile()

Kill "C:\Документы\primer. xls"

End Sub

Листинг 3.52. Удаление группы файлов

Sub DeleteFiles()

' Удаление всех файлов с расширением XLS из заданной папки

Kill "C:\Документы" & "*.xls"

End Sub

Произвольный текст в строке состояния

Sub ChangeStatusBarText()

Application. StatusBar = "Как надоело работать!!!"

End Sub

Восстановление строки состояния

Sub ReturnStatusBarText()

Application. StatusBar = False

End Sub

Бегущая строка в строке состояния

Sub MovingTextInStatusBar()

Dim intSpaces As Integer

' Изменение количества пробелов в начале строки (от 20 до 0) - _

строка бежит (скорее, ползет) влево

For intSpaces = 20 To 0 Step -1

' Запись текста в строку состояния

Application. StatusBar = Space(intSpaces) & "Как надоело работать!!!"

' Выдерживаем паузу

Application. Wait Now + TimeValue("00:00:01")

' Дадим Excel обработать пользовательский ввод

DoEvents

Next

Application. StatusBar = False

End Sub

Быстрое изменение заголовка окна

Sub NewTitle()

Application. Caption = "Какая хорошая погода"

End Sub

Быстрое изменение заголовка окна_2

Sub NewTitle()

Application. Caption = "Какая хорошая погода"

ActiveWindow. Caption = "А завтра будет дождь"

End Sub

Изменение заголовка окна (со скрытием названия файла)

Sub NewTitle()

Application. Caption = "Какая хорошая погода"

ActiveWindow. Caption = ""

End Sub

Возврат к первоначальному заголовку

Sub ReturnTitle()

' Возвращение заголовка приложения (то есть Excel)

Application. Caption = Empty

' Указание правильного названия открытого файла (книги)

ActiveWindow. Caption = ThisWorkbook. Name

End Sub

Что открыто в данный момент

Sub WorkBooksList()

Dim book As Object

' Вывод имени каждой рабочей книги

For Each book In Workbooks

MsgBox (book. Name)

Next

End Sub

Работа с текстовыми файлами

Открываются файлы командой Open, а закрываются - командой Close.

Sub Test()

Open "file. txt" For Input As #1

Close #1

End Sub

Запись и чтение текстового файла

Sub Test()

Open "file. txt" For Output As #1

Print #1, "Этот текст будет записан в файл"

Close #1

Open "file. txt" For Input As #1

Dim s As String

Input #1, s

MsgBox s

Close #1

End Sub

Для записи используется оператор Print, а для чтения - Input. У этих операторов есть свои особенности.

Print #1, "Hello, File"

Оператор Input #1 прочитает только Hello и все. Запятая воспринимается как разделитеть. Чтобы прочитать строку целиком, используется оператор Line Input.

Sub Test()

Open "file. txt" For Output As #1

Print #1, "Hello, File"

Close #1

Open "file. txt" For Input As #1

Dim s As String

Line Input #1, s

MsgBox s

Close #1

End Sub

Обработка нескольких текстовых файлов

Sub ImportTextFiles()

Dim fsSearch As FileSearch

Dim strFileName As String

Dim strPath As String

Dim i As Integer

' Задание пути и возможного имени файла

strFileName = ThisWorkbook. path & "\"

strPath = "text??.txt"

' Создание объекта FileSearch

Set fsSearch = Application. FileSearch

' Настройка объекта для поиска

With fsSearch

' Маска для поиска

.LookIn = strFileName

' Путь для поиска

.FileName = strPath

' Поиск всех файлов, удовлетворяющих маске

.Execute

' Выход, если файлы не существуют

If .FoundFiles. Count = 0 Then

MsgBox "Файлы не обнаружены"

Exit Sub

End If

End With

' Обработка найденных файлов

For i = 1 To fsSearch. FoundFiles. Count

Call ImportTextFile(fsSearch. FoundFiles(i))

Next i

End Sub

Sub ImportTextFile(FileName As String)

' Импорт файла

Workbooks. OpenText FileName:=FileName, _

Origin:=xlWindows, _

StartRow:=1, _

DataType:=xlFixedWidth, _

FieldInfo:= _

Array(Array(0, 1), Array(3, 1), Array(12, 1))

' Ввод формул суммирования

Range("D1").Value = "A"

Range("D2").Value = "B"

Range("D3").Value = "C"

Range("E1:E3").Formula = "=COUNTIF(B:B, D1)"

Range("F1:F3").Formula = "=SUMIF(B:B, D1,C:C)"

End Sub

Определение конца строки текстового файла

Sub Test()

Open "file. txt" For Output As #1

Print #1, "Hello, File"

Close #1

Open "file. txt" For Input As #1

Dim s As String

While Not EOF(1)

Input #1, s

MsgBox s

Wend

Close #1

End Sub

Копирование из текстового файла в эксель

Dim TextLine

i = 1

Open "C:\MyFile. txt" For Input As #1

Do While Not EOF(1)

Line Input #1, TextLine

ThisWorkbook. Worksheets("Лист1").Cells(i, 1).Value = TextLine

i = i + 1

Loop

Close #1

Копирование содержимого в текстовый файл_1

Sub Range2TXT()

MyFile = "C:\File. txt" 'путь к файлу

Open MyFile For Output As #1 'открыли для записи

For Each i In Selection 'листаем ячейки выделенного диапазона

Print #1, i 'пишем (с начала)

Next

Close #1 'закрываем

End Sub

Копирование содержимого в текстовый файл_2

Sub SaveAsText()

Dim cell As Range

' Открытие файла для сохранения (имя файла соответствует имени _

рабочей книги, но отличается расширением - TXT)

Open ThisWorkbook. Path & "\" & ThisWorkbook. Name & ".txt" _

For Output As #1

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

For Each cell In ActiveSheet. UsedRange

If Not IsEmpty(cell) Then

Print #1, cell. Address, cell. Formula

End If

Next

' Не забываем закрывать файл

Close #1

End Sub

Экспорт данных в txt

Sub ExportAsText()

Dim lngRow As Long

Dim intCol As Integer

' Открытие файла для сохранения

Open "C:\primer. txt" For Output As #1

' Запись выделенной части таблицы в файл (построчно)

For lngRow = 1 To Selection. Rows. Count

' Запись содержимого всех столбцов строки lngRow

For intCol = 1 To Selection. Columns. Count

Write #1, Selection. Cells(lngRow, intCol).Value;

Next intCol

' Начнем новую строку в файле

Print #1, ""

Next lngRow

' Не забываем закрыть файл

Close #1

End Sub

Sub ImportText()

Dim strLine As String ' Одна строка файла

Dim strCurChar As String * 1 ' Анализируемый символ строки файла

Dim strValue As String ' Значение для записи в ячейку

Dim lngRow As Long ' Номер текущей строки

Dim intCol As Integer ' Номер текущего столбца

Dim i As Integer

' Открытие импортируемого файла

Open "C:\primer. txt" For Input As #1

' Считываем все строки файла и записываем данные, разделенные _

запятой, в ячейки таблицы (начиная с текущей ячейки)

Do Until EOF(1)

' Считываем строку из файла

Line Input #1, strLine

' Разбираем считанную строку

For i = 1 To Len(strLine)

strCurChar = Mid(strLine, i, 1)

If strCurChar = "," Then

' Найден разделитель столбцов - запятая. Запишем _

сформированное значение в ячейку

ActiveCell. Offset(lngRow, intCol) = strValue

intCol = intCol + 1

strValue = ""

ElseIf i = Len(strLine) Then

' Конец строки - запишем в таблицу последнее _

значение в строке (перед этим дополним его последним _

символом строки, кроме кавычки)

If strCurChar <> Chr(34) Then

strValue = strValue & strCurChar

End If

' Запись в таблицу

ActiveCell. Offset(lngRow, intCol) = strValue

strValue = ""

ElseIf strCurChar <> Chr(34) Then

' Добавление символа в формируемое значение ячейки _

(кавычки игнорируются)

strValue = strValue & strCurChar

End If

Next i

' Переход к новой строке таблицы

intCol = 0

lngRow = lngRow + 1

Loop

' Закрываем файл

Close #1

End Sub

Экспорт данных в html

Sub ExportAsHtmlFile()

Dim strStyle As String ' Параметры стиля отображения ячейки

Dim strAlign As String ' Параметры выравнивания ячейки

Dim strOut As String ' Выходная строка с HTML-кодом

Dim cell As Object ' Обрабатываемая ячейка

Dim strCellText As String ' Текст обрабатываемой ячейки

Dim lngRow As Long ' Номер строки обрабатываемой ячейки

Dim lngLastRow As Long ' Номер строки предыдущей ячейки

Dim strTemp As String

Dim strFileName As String ' Имя файла для сохранения HTML-кода

Dim i As Long

' Запрос у пользователя имени файла для сохранения

strFileName = Application. GetSaveAsFilename( _

InitialFileName:="Primer. htm", _

fileFilter:="HTML Files(*.htm), *.htm")

' Проверка, задал ли пользователь имя файла (если нет, _

то можно выходить)

If strFileName = "" Then Exit Sub

lngLastRow = Selection. Row

' Просмотр всех выделенных ячеек

For Each cell In Selection

' Значение строки для рассматриваемой ячейки

lngRow = cell. Row

' Если перешли на другую строку, то вставляем <tr>

If lngRow <> lngLastRow Then

strOut = strOut & vbTab & "</tr>" & vbCrLf & vbTab & _

"<tr>" & vbCrLf

' Переход на следующую сроку

lngLastRow = lngRow

End If

' Задание шрифта ячейки

If Not IsNull(cell. Font. Size) Then

strStyle = " style=" & "font-size: " & Int(100 * _

cell. Font. Size / 19) & "%;"

End If

' Для полужирного шрифта вставляем <b>

If cell. Font. Bold Then

strCellText = "<b>" & strCellText & "</b>"

End If

' Задание выравнивания

If cell. HorizontalAlignment = xlRight Then

' По правому краю

strAlign = " align=" & "right"

ElseIf cell. HorizontalAlignment = xlCenter Then

' По центру

strAlign = " align=" & "center"

Else

' По левому краю (по умолчанию)

strAlign = ""

End If

' Чтение текста в ячейке

strCellText = cell. Text

' Если нужно, то вертикальный вывод текста (в строку strTemp _

с последующим перенесением обратно в strCellText)

If cell. Orientation <> xlHorizontal Then

strTemp = ""

' Печать после каждого символа специального _

разделителя - <br>

For i = 1 To Len(strCellText)

strTemp = strTemp & Mid$(strCellText, i, 1) & "<br>"

Next i

strCellText = strTemp

strStyle = ""

End If

strOut = strOut & vbTab & vbTab & "<td" & strStyle & _

strAlign & ">" & strCellText & "</td>" & vbCrLf

Next

' Вставка <tr> для первой строки и </tr> - для последней

strOut = vbTab & "<tr>" & vbCrLf & strOut & vbTab & "</tr>" & vbCrLf

' Вставка дескриптора <table>

strOut = "<table border=1 cellpadding=3 cellspacing=1>" _

& vbCrLf & strOut & vbCrLf & "</table>"

' Сохранение HTML-кода в файл

Open strFileName For Output As 1

Print #1, strOut

Close 1

' Вывод окна с информационным сообщением о результатах работы

MsgBox Selection. Count & " ячеек экспортировано в файл " & _

strFileName

End Sub

Импорт данных, для которых нужно более 256 столбцов

Sub ImportWideSheet()

Dim rgRange As Range ' Хранит заполняемую ячейку