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

Поскольку фантазия некоторых пользователей ничем не ограничена, да и хочется сделать макрос универсальным, необходимо сделать так, чтобы пользователь мог задать параметр ЯчейкаДляВставки в любом виде - будь то ссылка на ячейку, строку или столбец, или же имя столбца или номер строки.
Если же ни одной книги Excel в данный момент не открыто, - макрос должен догадаться, что необходимо создать новую книгу, содержащую один лист.

Потому и была написана функция GetCell, которую можно использовать следующим образом:

Sub ПримерИспользования_GetCell()

    ' вставляем значение в первую пустую ячейку столбца A

    ' (вставка производится ниже всех данных в первом столбце листа)

    GetCell("a").Value = Now

    ' то же самое, но с другими вариантами параметра функции (все 4 способа равнозначны)

    GetCell("a:a").Value = 111

    GetCell(Columns(1)).Value = 222

    GetCell([a:a]).Value = 333

    '  ============ вставка в первую незаполненную ячейку третьей строки =================

    GetCell(Destination:=3).Value = 1

    ' то же самое, но с другими вариантами параметра функции (все 4 способа равнозначны)

    GetCell("3").Value = 2

    GetCell(Rows(3)).Value = 3

    GetCell([3:3]).Value = 4

    '  ============ другие варианты использования =================

    GetCell().Value = "активная ячейка"    ' вставка в заданную ячейку (вызов без параметра)

    GetCell("NewSheet").Value = "на новый лист в ячейку A1"    ' создаётся новый лист

    GetCell("NewWorkbook").Value = "в новую книгу в ячейку A1"    ' создаётся новая книга Excel

End Sub

Как вы заметили, в качестве параметра функции можно использовать предопределённые текстовые константы "NewSheet" и "NewWorkbook"

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

Пример использования функции GetCell можно посмотреть
в надстройке для импорта данных из CSV на лист Excel

Function GetCell(Optional ByRef Destination As Variant) As Range

    ' Функция получает в качестве параметра ссылку на диапазон

    ' Возвращает ячейку для вставки данных в зависимости от параметра:

    '   если параметр не задан - возвращается активная ячейка текущей книги

    '   если параметр является ссылкой на ячейку - возвращается эта ячейка

    '   если параметр является ссылкой на строку - возвращается первая незаполненная ячейка этой строки

    '   если параметр является ссылкой на столбец - возвращается первая незаполненная ячейка этого столбца

    On Error Resume Next: Err.Clear

    If IsMissing(Destination) Then

        If ActiveWorkbook Is Nothing Then Workbooks.Add(xlWBATWorksheet).Worksheets(1).Name = "Данные"

        Set GetCell = ActiveCell: Exit Function

    End If

    If Not IsObject(Destination) Then If IsNumeric(Destination) Then Destination = Val(Destination)

    Select Case TypeName(Destination)

        Case "String"

            If Destination = "NewWorkbook" Then Workbooks.Add(xlWBATWorksheet).Worksheets(1).Name = "Данные"

            If ActiveWorkbook Is Nothing Then Workbooks.Add(xlWBATWorksheet).Worksheets(1).Name = "Данные"

            If Destination = "NewSheet" Then ActiveWorkbook.Worksheets.Add , ActiveSheet

            Set GetCell = Range(Destination)

            If Err.Number = 1004 Then

                If Destination Like String(Len(Destination), "[A-z]") Then _

                   Err.Clear: Set GetCell = Range(Destination & ":" & Destination)

                'Debug.Print Err.Number, Err.Description

                If Err Then Set GetCell = ActiveCell: Exit Function    ' неопознанная ошибка

            End If

        Case "Integer", "Long", "Double"

            If ActiveWorkbook Is Nothing Then Workbooks.Add(xlWBATWorksheet).Worksheets(1).Name = "Данные"

            Err.Clear: If Val(Destination) > 0 Then Set GetCell = Rows(Val(Destination))

            If Err Then Set GetCell = ActiveCell: Exit Function    ' неопознанная ошибка

        Case "Range": Set GetCell = Destination

        Case "Workbook": Set GetCell = Destination.Worksheets(1).[a:a]

        Case "Worksheet": Set GetCell = Destination.[a:a]

        Case Else

            Debug.Print "Another parameter type: ", TypeName(Destination)

            Set GetCell = ActiveCell: Exit Function    ' неопознанная ошибка

    End Select

    If GetCell Is Nothing Then Set GetCell = ActiveCell: Exit Function

    Select Case True

        Case GetCell.Address = GetCell.EntireColumn.Address

            Set GetCell = GetCell.Columns(1).Cells(GetCell.Rows.Count).End(xlUp).Offset(1)

        Case GetCell.Address = GetCell.EntireRow.Address

            Set GetCell = GetCell.Rows(1).Cells(GetCell.Columns.Count).End(xlToLeft).Offset(, 1)

        Case Else: Set GetCell = GetCell.Cells(1)

    End Select

End Function

• 17467 просмотро