Зачастую требуется в функциях ввести дополнительный параметр, где пользователь может задать ссылку на ячейку
(например, место для вставки данных)
Поскольку фантазия некоторых пользователей ничем не ограничена, да и хочется сделать макрос универсальным, необходимо сделать так, чтобы пользователь мог задать параметр ЯчейкаДляВставки в любом виде - будь то ссылка на ячейку, строку или столбец, или же имя столбца или номер строки.
Если же ни одной книги 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
Комментарии
Сергей, так попробуйте:
(вместо B4 подставив адрес нужной ячейки)
msgbox Range("B4").Hyperlinks(1).address
Подскажите пожалуйста, как получить ссылку из конкретной ячейки? Ссылка записана не через =ГИПЕРССЫЛКА("";""), а именно в ячейку (как мне ее вернуть?).
Спасибо.
Отправить комментарий