Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
mironov_gotovye_makrosy_v_vba_excel.doc
Скачиваний:
0
Добавлен:
01.07.2025
Размер:
1.41 Mб
Скачать

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

Sub TableSpeedTest()

Dim alngData() As Long ' Массив с числами

Dim lngCount As Long ' Количество элементов в массиве

Dim dtStart As Date ' Хранит время (и даже дату) начала _

тестирования

Dim strArrayToTable As String ' Время записи в таблицу

Dim strTableToArray As String ' Время чтения из таблицы

Dim strMessage As String

Dim i As Long

' Подготовка диапазона ячеек

Range("A:A").ClearContents

' Ввод размера массива, формирование массива заданного размера

lngCount = InputBox("Введите количество элементов")

ReDim alngData(1 To lngCount)

' Заполнение массива данными

For i = 1 To lngCount

alngData(i) = i

Next i

' Перенос массива в таблицу

Application.ScreenUpdating = False

dtStart = Timer

For i = 1 To lngCount

Cells(i, 1) = i

Next i

strArrayToTable = Format(Timer - dtStart, "00:00")

' Чтение данных из таблицы обратно в массив

dtStart = Timer

For i = 1 To lngCount

alngData(i) = Cells(i, 1)

Next i

strTableToArray = Format(Timer - dtStart, "00:00")

Application.ScreenUpdating = True

' Вывод на экран результатов тестирования

strMessage = "Запись: " & strArrayToTable & vbCrLf & _

"Чтение: " & strTableToArray

MsgBox strMessage, , lngCount & " элементов"

End Sub

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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Address = "$A$1" Then MsgBox "Hello world"

End Sub

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

Sub HideString()

Rows(2).Hidden = True

End Sub

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

Sub HideStrings()

Rows("3:5").Hidden = True

End Sub

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

Sub HideCollumn()

Columns(2).Hidden = True

End Sub

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

Sub HideCollumns()

Columns("E:F").Hidden = True

End Sub

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

Sub HideCell()

Range("Секрет").EntireRow.Hidden = True

End Sub

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

Sub HideCell()

Range("B3:D4").EntireRow.Hidden = True

End Sub

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

Sub HideCell()

Range("Секрет").EntireColumn.Hidden = True

End Sub

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

Sub HideCell()

Range("C2:D5").EntireColumn.Hidden = True

End Sub

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

Sub BlinkingCell()

Static intCalls As Integer ' Счетчик количества миганий

' Если ячейка мигала менее 10 раз, то изменим _

в очередной раз ее цвет

If intCalls < 10 Then

intCalls = intCalls + 1

' Определение, какой цвет необходимо установить

If Range("A1").Interior.Color <> RGB(255, 0, 0) Then

' Цвет ячейки не красный, так что теперь назначим _

именно красный цвет

Range("A1").Interior.Color = RGB(255, 0, 0)

Else

' Назначим ячейке зеленый цвет

Range("A1").Interior.Color = RGB(0, 255, 0)

End If

' Эту процедуру необходимо вызвать через 5 секунд

Application.OnTime Now + TimeValue("00:00:05"), "BlinkingCell"

Else

' Хватит мигать

Range("A1").Interior.ColorIndex = xlNone

intCalls = 0

End If

End Sub

Соседние файлы в предмете [НЕСОРТИРОВАННОЕ]