Готовые макросы в vba excel, Миронов Глава Макросы 9
![]()
|
Взять слово с 13 символа в ячейке'берём значение ячейка А4 из Отчёта iMonth = "за период с Июль 2 008 по Июль 2 008 " 'берём слово начиная с 13-го символа iMonth = Evaluate("MID(TRIM(" & """" & iMonth & """" & "),13,(SEARCH("" "",TRIM(" & """" & iMonth & """" & "),13)-13))") 'вставляем это слово в книгу Ведомость AddressSht.Range("A1") = iMonth Создание изменяемого списка (таблица)Sub Макрос2() With ActiveSheet .ListObjects.Add(xlSrcRange, .Range("$A$8:$AR$" & .Cells(Rows.Count, 1).End(xlUp).Row), , xlYes).Name = _ "Список1" End With End Sub Проверка на пустое значениеIsNull(выражение) - проверка на пустое значение Пересечение ячеекSub Test() With ActiveWorkbook Worksheets("Лист1").Activate Dim Range1 As Range Set Range1 = Range("A1:A8 A8:D8") Range1.Value = "test" End With End Sub Умножение выделенного диапазона на 2Sub Test() Dim cur_range As Range With ActiveSheet Set cur_range = Selection cur_range.Activate For x = 1 To cur_range.Rows.Count For y = 1 To cur_range.Columns.Count ' значению ячейки присвоить значение умноженно на 2 cur_range(x, y) = cur_range(x, y).Value * 2 Next y Next x End With End Sub Одновременное умножение всех данных диапазонаSub MultAllCells() Dim dblMult As Double Dim cell As Range ' Ввод коэффициента для умножения dblMult = InputBox("Введите коэффициент, на который следует умножать") ' Умножение содержимого на введенный коэффициент For Each cell In Selection If IsNumeric(cell.Value) And cell.Value <> "" Then ' Умножаются только ячейки, содержащие числовые данные cell.Value = cell.Value * dblMult Else MsgBox "В ячейке " & cell.Address & " нечисловое значение" End If Next End Sub Деление диапазона на 100Sub Test23() Dim iRange As Range Dim kRange As Range i = 1 j = 1 m = 5 n = 2 Set iRange = Range(Cells(i, j), Cells(m, n)) For Each kRange In iRange kRange.Value = kRange.Value / 100 Next End Sub Возведение каждой ячейки диапазона в квадрат![]() Суммирование данных только видимых ячеекFunction СуммаВид(Диапазон) As Double ' Просмотр всех ячеек заданного диапазона For Each Ячейка In Диапазон ' Анализ только видимых ячеек If Not Ячейка.EntireRow.Hidden And Not _ Ячейка.EntireColumn.Hidden Then ' При расчете учитываются только ячейки _ с численными значениями If IsNumeric(Ячейка) = True Then СуммаВид = СуммаВид + Ячейка End If End If Next End Function Сумма ячеек с числовыми значениямиSub CalculateSum() Dim i As Integer Dim intSum As Integer ' Расчет суммы ячеек столбца "A" (с первой по пятую) For i = 1 To 5 If IsNumeric(Cells(i, 1)) Then intSum = intSum + Cells(i, 1) End If Next MsgBox "Сумма ячеек: " & intSum End Sub При суммировании — курсор внутри диапазонаFunction Сумма(Диапазон, АдресЯчейки) As Double ' Просмотр всех ячеек диапазона For Each Ячейка In Диапазон ' Проверка, чтобы в суммировании не участвовала _ ячейка с формулой If АдресЯчейки.Address <> Ячейка.Address Then ' В суммировании участвуют только ячейки _ с численными значениями If IsNumeric(Ячейка) = True Then Сумма = Сумма + Ячейка End If End If Next End Function Начисление процентов в зависимости от суммы_1Function dhCalculatePercent(lngSum As Long) As Double ' Процентные ставки (декларация констант) Const dblRate1 As Double = 0.09 Const dblRate2 As Double = 0.11 Const dblRate3 As Double = 0.15 ' Граничные суммы вкладов (декларация констант) Const intSum1 As Long = 5000 Const intSum2 As Long = 10000 ' Возвращаем сумму, умноженную на соответствующую ставку If lngSum < intSum1 Then dhCalculatePercent = lngSum * dblRate1 ElseIf lngSum < intSum2 Then dhCalculatePercent = lngSum * dblRate2 Else dhCalculatePercent = lngSum * dblRate3 End If End Function |