Чат kullun
kullun (off) Хозяин
1 июня 2018, 09:19
======работа с умной таблицей====
Sub Show_Form_Main()
UserForm1.Show
End Sub
Sub Кнопка7_Щелчок()
Call Show_Form_Main
End Sub
Sub Del_Rows()
Dim Sh As Worksheet
Dim LstObj As ListObject
Dim lstRow As ListRow
Set Sh = ThisWorkbook.Worksheets("Лист6")
Set LstObj = Sh.ListObjects("Таблица2")
On Error Resume Next
LstObj.ListRows.Item(ActiveCell.Row - 10).Delete
End Sub
Sub Add_Doc_To_Registr()
Dim Sh As Worksheet
Dim LstObj As ListObject
Dim lstRow As ListRow
Dim Kol_vo_Strok As Integer
Dim lstObj_tb1 As ListObject
Dim i As Integer
Set Sh = ThisWorkbook.Worksheets("Лист6")
Set LstObj = Sh.ListObjects("Таблица2")
Kol_vo_Strok = LstObj.TotalsRowRange.Columns(1).Value
'MsgBox Kol_vo_Strok
Set Sh = ThisWorkbook.Worksheets("Лист6")
Set lstObj_tb1 = Sh.ListObjects("Таблица1")
For i = 1 To Kol_vo_Strok
Set lstRow = lstObj_tb1.ListRows.Add
lstRow.Range(2) = Sh.Range("J8")
lstRow.Range(3) = Sh.Range("K8")
lstRow.Range(4) = LstObj.ListRows(i).Range(2)
lstRow.Range(5) = LstObj.ListRows(i).Range(3)
Next i
End Sub
-----
kullun (off) Хозяин
31 мая 2018, 11:39
Sub Test1()
'Операции над диапазоном пока не встретим пустую ячейку
On Error Resume Next
Dim r As Integer
r = 1
While (Application.WorksheetFunction.CountA(Cells(r, 1)) = 1)
Cells(r, 1).Interior.Color = RGB(255, 0, 0)
r = r + 1
Wend
MsgBox "Не пустых строк " & r - 1
End Sub
-----
kullun (off) Хозяин
31 мая 2018, 11:33
Sub Test1()
'Операции над диапазоном пока не встретим пустую ячейку
On Error Resume Next
Dim r As Integer
r = 1
While (Application.WorksheetFunction.CountA(Cells(r, 1)) = 1)
'Cells(r, 1).Interior.Color = RGB(255, 0, 0)
Cells(r, 1).Delete
r = r + 1
Wend
End Sub
-----
kullun (off) Хозяин
31 мая 2018, 11:13
Удаление всех пустых строк
Следующая процедура удаляет все пустые строки на активном рабочем листе. Она об-
ладает достаточно большим быстродействием, поскольку не проверяет все без исключе-
ния строки, а просматривает только строки в так называемом “используемом диапазоне”,
определяемом с помощью свойства UsedRange объекта Worksheet.
Sub DeleteEmptyRows()
Dim LastRow As Long
Dim r As Long
Dim Counter As Long
Application.ScreenUpdating = False
LastRow = ActiveSheet.UsedRange.Rows.Count + _
ActiveSheet.UsedRange.Rows(1).Row - 1
For r = LastRow To 1 Step -1
If Application.WorksheetFunction.CountA(Rows(r)) = 0 Then
Rows(r).Delete
Counter = Counter + 1
End If
Next r
Application.ScreenUpdating = True
MsgBox Counter & " пустые строки удалены."
End Sub
значение LastRow вычисляет-
ся таким образом: к найденному количеству строк используемого диапазона прибавляется
номер первой строки текущего диапазона и вычитается 1.
В процедуре применена функция Excel СЧЕТЗ (COUNTA), определяющая, является ли
строка пустой.Если данная функция для конкретной строки возвращает 0, то эта строка
пустая. Обратите внимание на то, что процедура просматривает строки снизу вверх и ис-
пользует отрицательное значение шага в цикле For-Next. Это необходимо, поскольку при
удалении все последующие строки перемещаются вверх в рабочем листе. Если бы в цикле
просмотр выполнялся сверху вниз, то значение счетчика цикла после удаления строки
оказалось бы неправильным.
В макросе используется еще одна переменная, Counter, с помощью которой подсчи-
тывается количество удаленных строк. Эта величина отображается в окне сообщения
по завершении процедуры.
-----
kullun (off) Хозяин
31 мая 2018, 11:03
Просмотр выделенного диапазона
Sub ColorNegative()
' Выбирает красный цвет для ячеек с отрицательными значениями
Dim cell As Range
If TypeName(Selection) <> "Range: Then Exit Sub
Application.ScreenUpdating = False
For Each cell In Selection
If cell.Value < 0 Then
cell.Interior.Color = RGB(255, 0, 0)
Else
cell.Interior.Color = xlNone
End If
Next cell
End Sub
Sub ColorNegative2()
' Определяет красный цвет для ячеек с отрицательными значениями
Dim WorkRange As Range
Dim cell As Range
If TypeName(Selection) <> "Range" Then Exit Sub
Application.ScreenUpdating = False
Set WorkRange = Application.Intersect(Selection, _
ActiveSheet.UsedRange)
For Each cell In WorkRange
If cell.Value < 0 Then
cell.Interior.Color = RGB(255, 0, 0)
Else
cell.Interior.Color = xlNone
End If
Next cell
End Sub
Диапазон,
используемый рабочим листом (ActiveSheet.UsedRange), включает ячейки В2:116. В результате пересечения этих
диапазонов получаем область D2:D16, которая намного меньше исходного выделенного
диапазона. Естественно, время, затрачиваемое на обработку 15 ячеек, намного меньше
времени, уходящего на обработку 1048576 ячеек.
==============================================================
Процедура Co lo r N eg a tiv e 2 представляет собой результат переработки преды-
дущей процедуры, но все же она недостаточно эффективна, поскольку обрабатывает пустые ячейки. Поэтому появилась третья версия, C olorN egative3, которая немного
больше по размеру, но намного эффективнее. В ней используется метод S p ecia lC ells,
с помощью которого генерируются два поднабора выделенной области: один поднабор
(Cons tantCe 11s) включает ячейки, которые содержат исключительно числовые констан-
ты; второй поднабор (Form ulaCells) включает ячейки, содержащие числовые формулы.
Обработка ячеек в этих поднаборах осуществляется с помощью двух циклов For Each-
Next. Благодаря тому что исключается обработка пустых и нетекстовых ячеек, скорость
выполнения макроса существенно увеличивается.
Sub ColorNegative3()
' Определяет красный цвет для ячеек с отрицательными значениями
Dim FormulaCells As Range, ConstantCells As Range
Dim cell As Range
If TypeName(Selection) <> "Range” Then Exit Sub
Application.ScreenUpdating = False
' Создание поднаборов на основе исходного выделения
On Error Resume Next
Set FormulaCells = Selection.SpecialCells( _
xlFormulas, xlNumbers)
Set ConstantCells = Selection.SpecialCells( _
xlConstants, INumbers)
On Error GoTo 0
' Обработка ячеек формулы
If Not FormulaCells Is Nothing Then
For Each cell In FormulaCells
If cell.Value < 0 Then
cell.Interior.Color = RGB(255, 0, 0)
Else
cell.Interior.Color = xlNone
End If
Next cell
End If
' Обработка ячеек, содержащих константы
If Not ConstantCells Is Nothing Then
For Each cell In ConstantCells
If cell.Value < 0 Then
cell.Interior.Color = RGB(255, 0, 0)
Else
cell.Interior.Color = xlNone
End If
Next cell
End If
Application.ScreenUpdating = True
End Sub
Оператор On Error необходим, поскольку метод SpecialCells генерирует ошиб
ку, если не находит в диапазоне ячеек указанного типа.
-----
kullun (off) Хозяин
31 мая 2018, 10:43
Идентификация типа выделенного диапазона
В Excel можно выделить следующие типы диапазонов:
> отдельная ячейка;
> смежный диапазон ячеек;
> один или несколько полных столбцов;
> одна или несколько полных строк;
> весь рабочий лист;
> комбинация перечисленных выше типов (называемая множественным выделением).
В случае множественного выделения (выделения нескольких диапазонов) объект
Range включает несмежные области. Чтобы определить, является ли выделение множе-
ственным, используйте метод Areas, возвращающий коллекцию Areas. Эта коллекция
представляет все диапазоны в множественном выделении.
Чтобы определить, содержатся ли в выделенном диапазоне множественные области,
воспользуйтесь следующим оператором:
NumAreas = Selection.Areas.Count
Если переменная NumAreas содержит значение, которое больше единицы, то выделе-
ние является множественным.
Ниже приводится код функции АгеаТуре, которая возвращает текстовую строку, опи-
сывающую тип выделенного диапазона.
Function АгеаТуре(RangeArea As Range) As String
' Возвращает тип диапазона
Select Case True
[b]Case RangeArea.Cells.CountLarge = 1
АгеаТуре = "Ячейка"
Case RangeArea.CountLarge = Cells.CountLarge
AreaType = "Рабочий лист"
Case RangeArea.Rows.Count = Cells.Rows.Count
AreaType = "Столбец"
Case RangeArea.Columns.Count = Cells.Columns.Count
AreaType = "Строка"
Case Else
AreaType = "Блок"
End Select
End Function
[/b]
Эта функция получает в качестве аргумента объект Range и возвращает одну из пяти
строк, описывающих данную область: Ячейка (Cell), Рабочий лист (Worksheet), Стол-
бец (Column), Строка (Row) или Блок (Block). Функция использует конструкцию Select
Case для идентификации одного из четырех выражений сравнения, которое имеет значе-
ние True. Например, если диапазон состоит из одной ячейки, функция возвращает значе-
ние ячейка. Если количество ячеек в диапазоне равно количеству ячеек на рабочем листе,
то функция возвращает рабочий лист. Если количество строк в диапазоне равно коли-
честву строк на рабочем листе, функция возвращает столбец. Если количество столбцов
в диапазоне равно количеству столбцов на рабочем листе, функция возвращает строка.
Если ни одно из выражений Case не равно True, то функция возвращает строку блок.
Обратите внимание на то, что для подсчета количества ячеек использовалось свой-
ство CountLarge. Как уже отмечалось, количество выделенных ячеек может превышать
предел для свойства Count.
-----
kullun (off) Хозяин
31 мая 2018, 10:24
Подсчет выделенных ячеек
Работая с макросом, который обрабатывает выделенный диапазон ячеек, можно ис-
пользовать свойство Count, чтобы определить, сколько ячеек содержится в выделенном
(или любом другом) диапазоне. Например, следующий оператор выводит окно сообщения,
которое отображает количество ячеек в текущем выделенном диапазоне:
MsgBox Selection.Count
В большинстве случаев можно воспользоваться свойством [u]Count. Если же нужно
подсчитать очень много ячеек (например, все ячейки на рабочем листе), исполь
зуйте свойство CountLarge вместо Count.[/u]
Если активный лист содержит диапазон Data, то следующий оператор присваивает
количество ячеек в диапазоне Data переменной CellCount:
CellCount = Range("Data").Count
Можно также подсчитать количество строк или столбцов в диапазоне. Следующее вы-
ражение вычисляет количество столбцов в выделенном в данный момент диапазоне:
Selection.Columns.Count
Для определения количества строк в диапазоне можно использовать свойство Rows.
Следующий оператор пересчитывает количество строк в диапазоне Data и присваивает
это количество переменной RowCount:
RowCount = Range("Data”).Rows.Count
-----
kullun (off) Хозяин
31 мая 2018, 10:19
Приостановка работы макроса для определения
диапазона пользователем
В некоторых ситуациях макрос должен взаимодействовать с пользователем. Например,
можно создать макрос, который приостанавливается, когда пользователь указывает диа-
пазон ячеек. Для этого воспользуйтесь функцией Excel InputBox.
Не путайте метод Excel InputBox с функцией VBA InputBox. Несмотря на идентич-
ность названий, это далеко не одно и то же.
Sub GetUserRange()
Dim UserRange As Range
Prompt = "Выберите диапазон для случайных чисел."
Title = "Выбор диапазона"
' Отображение окна ввода данных
On Error Resume Next
Set UserRange = Application.InputBox( _
Prompt:=Prompt, _
Title:=Title, _
Default:=ActiveCell.Address, _
Type:=8) 'Выбор диапазона
On Error GoTo 0
' Проверка, была ли нажата кнопка отмены?
If UserRange Is Nothing Then
MsgBox "Действие отменено."
Else
UserRange.Formula = "=RAND()"
End If
End Sub
Ключевым моментом в этой процедуре является присваивание аргументу Туре зна-
чения 8. Кроме того, обратите внимание на использование оператора On Error Resume
Next. Он игнорирует ошибку, происходящую по вине пользователя, который щелкает
на кнопке Cancel (Отмена). В таком случае переменная объекта UserRange не получа-
ет значения. В данном примере отображается окно сообщения с текстом “Действие отме-
нено”. Если же пользователь щелкнет на кнопке ОК, то макрос продолжит выполняться.
Строка On Error Go То указывает на переход к стандартной обработке ошибки.
Обязательно проверьте, включено ли обновление экрана при использовании ме
тода inputBox для выделения диапазона. Если обновление экрана отключено, при
перемещении окна ввода будет отображаться шлейф (рис. 9.7). Чтобы проконтро
лировать обновление экрана, в процессе выполнения макроса используйте свой
ство ScreenUpdating объекта Application.
-----
kullun (off) Хозяин
31 мая 2018, 10:12
Ввод значения в следующую пустую ячейку
Sub GetData()
Dim NextRow As Long
Dim Entryl As String, Entry2 As String
Do
' Идентификация следующей пустой строки
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
' Запрос на ввод данных
Entryl = InputBox("Введите имя")
If Entryl = "" Then Exit Sub
Entry2 = InputBox("Введите сумму")
If Entry2 = "" Then Exit Sub
' Запись данных
Cells(NextRow, 1) = Entryl
Cells(NextRow, 2) = Entry2
Loop
End Sub
Чтобы упростить представленную процедуру, проверка данных не выполнялась. За-
метьте, что это бесконечный цикл. Для выхода из него, когда пользователь щелкает
на кнопке Cancel (Отмена), используются операторы Exit Sub.
-----
kullun (off) Хозяин
31 мая 2018, 09:51
Запрос значения ячейки
Следующая процедура демонстрирует, как запросить у пользователя значение и вста-
вить его в ячейку А1 активного рабочего листа.
Sub GetValuelO
Range("Al").Value = InputBox("Введите значение")
End Sub
Sub GetValue2()
Dim UserEntry As Variant
UserEntry = InputBox("Введите значение")
If UserEntry <> "" Then Range("Al").Value = UserEntry
End Sub
Sub GetValue3()
Dim UserEntry As Variant
Dim Msg As String
Const MmVal As Integer = 1
Const MaxVal As Integer = 12
Msg = "Введите значение между " & MmVal & " и " & MaxVal
Do
UserEntry = InputBox(Msg)
If UserEntry = "" Then Exit Sub
If IsNumenc (UserEntry) Then
If UserEntry >= MmVal And UserEntry <= MaxVal _
Then Exit Do
End If
Msg = "Вы ввели НЕПРАВИЛЬНОЕ значение."
Msg = Msg & vbNewLine
Msg = Msg & "Введите значение между " & _
MinVal & " и " & MaxVal
Loop
ActiveSheet.Range("Al").Value = UserEntry
End Sub
-----
стр. Пред. 1,2,3 ... 7,8,9 ... 12,13,14 След.
0.048 сек
SQL: 3