Макросы VBA Excel — Страница 33

Пользовательская функция суммы для ячеек с двумя значениями

Суммирование ячеек с двумя значениями - пользовательская функция

Данная функция предназначена для суммирования итогов и подитогов в таблице Excel, если в ячейках находятся сразу 2 значения
(к примеру, фактическое, и по плану), разделённые переводом строки (нажатием Alt + Enter)

При суммировании учитывается группировка строк.

Для суммирования несгруппированных строк используется функция СуммаПланФакт,
а для сгруппированных строк - функция СуммаПодитоговПланФакт

Примеры формул на листе Excel

=СуммаПодитоговПланФакт(D8:D9)
=СуммаПодитоговПланФакт(F8;H8;J8)
=СуммаПланФакт(D4:D10)

Заполнение пользовательских свойств книги Excel

Чтобы заполнить встроенные свойства (например, Тема, Руководитель, Организация, Автор, Категория, Ключевые слова, Название, Комментарий и т.д.) документа Excel, можно воспользоваться функцией FillWorkbookProperties:
(в её работе используется коллекция BuiltinDocumentProperties)

Sub ПримерИспользования_FillWorkbookProperties()
    FillWorkbookProperties ActiveWorkbook, "Название", "Тема", "Автор", "Ключевые Слова", , "EducatedFool", , "Компания"
End Sub

Код функции FillWorkbookProperties:

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

Function Range2TXT(ByRef ra As Range, Optional ByVal ColumnsSeparator$ = vbTab, _
                   Optional ByVal RowsSeparator$ = vbNewLine) As String
    If ra.Cells.Count = 1 Then Range2TXT = ra.Value & RowsSeparator$: Exit Function
    If ra.Areas.Count > 1 Then
        Dim ar As Range
        For Each ar In ra.Areas
            Range2TXT = Range2TXT & Range2TXT(ar, ColumnsSeparator$, RowsSeparator$)
        Next ar
        Exit Function
    End If
    arr = ra.Value
    For i = LBound(arr, 1) To UBound(arr, 1)

Поиск элементов массива в текстовой строке

Данная функция позволяет определить, содержатся ли в текстовой строке элементы массива:

Function LikeAnItemOfArray(ByVal txt$, ByVal arr) As Boolean
    ' возвращает TRUE, если в строке txt$ содержится хоть один элемент из массива arr
    For Each Item In arr
        pos = pos + InStr(1, txt$, Item, vbTextCompare)
    Next
    LikeAnItemOfArray = pos > 0
End Function

Преобразование пути к сетевой папке в формат UNC

К примеру, требуется преобразовать путь вида Z:\Папка\Разное\ (где Z - буква сетевого диска) в путь вида \\server\Files\Папка\Разное

Для этого можно использовать возможности объекта FileSystemObject:

Sub ПолучениеСетевогоПутиПапки()
    ОбычныйПуть = "Z:\Папка\Разное\"
 
    With CreateObject("Scripting.FileSystemObject").getfolder(ОбычныйПуть)
        СетевойПуть = Replace(.Path, .Drive.Path, .Drive.ShareName)
    End With
 
    Debug.Print ОбычныйПуть, СетевойПуть
    ' СетевойПуть = \\server\Files\Папка\Разное
End Sub