2) Получение даты, отстоящей от текущей даты, на один месяц =ДАТАМЕС(СЕГОДНЯ(); 1)
3) И получение последнего дня текущего месяца =КОНМЕСЯЦА(СЕГОДНЯ(); 0)
|
With CreateObject("OCATP.OCATP.1")
iResult1 = .RANDBETWEEN(-100, 100)
iResult2 = CDate(.EDATE(Date, 1))
iResult3 = CDate(.EOMONTH(Date, 0))
End With |
|
Если же Вам необходимы подсказки к функциям (количество аргументов, их тип и
обязательность), то используйте раннее связывание. Для этого, в редакторе VBA
в меню Tools выберите команду References и
подключите Microsoft Office Web Components Function Library (MSOWCF.DLL)
|
Dim iOWCATP As New MSOWCFLib.OCATP
Dim iDate As Date, iResult As Date
iDate = Now 'Date
iResult = iOWCATP.EOMONTH(iDate, 0)
MsgBox "Последний день этого месяца : " & iResult |
|
|
Dim iDate As Date, iResult1#, iResult2#, iResult3#
With New MSOWCFLib.OCATP
iDate = #1/31/2007# '39113
iResult1 = .EDATE(CDbl(iDate), 1)
iResult2 = .CONVERT(451, "F", "C")
iResult3 = .WEEKNUM(CDbl(Date), 2)
MsgBox "Дата, отстоящая на один месяц от " & iDate & " это " & CDate(iResult1)
MsgBox "451 по Фаренгейту, а в цельсиях, это " & iResult2
MsgBox "Сейчас идёт неделя# " & iResult3
End With |
Комментарий : Если найти OWC не удаётся, а применение первых советов,
приводит к возникновению ошибки, то, по всей видимости, на Вашем компьютере
просто нет указанного компонента. Однако, его можно скачать с официального
сайта Microsoft.
Download Office XP Tool: Web Components
Download Office 2003 Add-in: Office Web Components
Ответ :
Для того, чтобы загрузить XLL и автоматически зарегистрировать все
функции и команды, содержащиеся в этом ресурсе, можно использовать метод
RegisterXLL об'екта Application, например :
Application.RegisterXLL Application.LibraryPath & "\Analysis\ANALYS32.XLL"
| |
|
Application.RegisterXLL FileName:=Application.LibraryPath & "\Analysis\ANALYS32.XLL"
|
Получить же список всех зарегистрированных функций можно с помощью свойства
RegisteredFunctions об'екта Application
|
Application.RegisterXLL Application.LibraryPath & "\Analysis\ANALYS32.XLL"
iArray = Application.RegisteredFunctions
If IsArray(iArray) = True Then
Range("A1").Resize(UBound(iArray), 3).Value = iArray
Range("A:C").EntireColumn.AutoFit 'Columns("A:C").AutoFit
Else
MsgBox "Странно ... но зарегистрированных функций, нет"
End If | |
|
iFileName$ = Application.LibraryPath & "\Analysis\ANALYS32.XLL"
Application.RegisterXLL FileName:=iFileName$
iArray = Application.RegisteredFunctions
If Not IsNull(iArray) Then
Cells(1, 1).Resize(UBound(iArray), 3).Value = iArray
Else
MsgBox "Зарегистрированных функций, нет"
End If | |
|
iFileName$ = Application.LibraryPath & "\Analysis\ANALYS32.XLL"
If Application.RegisterXLL(iFileName$) = True Then
iArray = Application.RegisteredFunctions
Cells(1).Resize(UBound(iArray), 3) = iArray
Else
MsgBox "Загрузки XLL и регистрации функций, не произошло"
End If |
Комментарий : Если стандартная надстройка "Пакет анализа" или
"Analysis ToolPak" подключена(загружена), то, фактически, в повторном
использовании Application.RegisterXLL "ANALYS32.XLL" нет особого смысла.
Ответ :
Для того, чтобы в формуле преобразовать все абсолютные ссылки в
относительные или наоборот, можно использовать метод
ConvertFormula об'екта Application, например :
iFormula$ = "=SUM($A$2:$A$100)"
MsgBox Application.ConvertFormula(Formula:=iFormula$, FromReferenceStyle:=xlA1, ToReferenceStyle:=xlA1, ToAbsolute:=xlRelative)
MsgBox Application.ConvertFormula(Formula:=iFormula$, FromReferenceStyle:=xlA1, ToReferenceStyle:=xlA1, ToAbsolute:=xlAbsolute)
MsgBox Application.ConvertFormula(Formula:=iFormula$, FromReferenceStyle:=xlA1, ToReferenceStyle:=xlA1, ToAbsolute:=xlRelRowAbsColumn)
MsgBox Application.ConvertFormula(Formula:=iFormula$, FromReferenceStyle:=xlA1, ToReferenceStyle:=xlA1, ToAbsolute:=xlAbsRowRelColumn)
| |
Разумеется этот способ применим и для формул в стиле R1C1, т.е.
| iFormula$ = "=SUM(R2C1:R100C1)"
MsgBox Application.ConvertFormula(Formula:=iFormula$, FromReferenceStyle:=xlR1C1, ToReferenceStyle:=xlR1C1, ToAbsolute:=xlRelative)
MsgBox Application.ConvertFormula(Formula:=iFormula$, FromReferenceStyle:=xlR1C1, ToReferenceStyle:=xlR1C1, ToAbsolute:=xlRelative, RelativeTo:=Range("B2"))
|
Кроме того, данный метод может конвертировать адреса ячеек из
стиля A1 в R1C1 и наоборот [FAQ677]
Ответ :
Для того, чтобы во всех формулах определённого диапазона, заменить
все ссылки на относительные, можно просто удалить $
Range("A1:C100").Replace "$", "", xlPart | |
| ActiveSheet.UsedRange.Replace "$", "", xlPart | |
Однако, если символ $ может встречаться не только в ячейках с
формулами, то в этом случае, использование упрощённого варианта,
приведёт к его полному удалению. Чтобы этого не происходило, мы можем
ограничить диапазон только нужными ячейками, т.е.
|
Range("A1:C100").SpecialCells(xlFormulas).Replace "$", "", xlPart | |
|
ActiveSheet.UsedRange.SpecialCells(xlFormulas).Replace "$", "", xlPart | |
Если же Вы предпочитаете стиль ссылок R1C1, то :
| iRefStyle = Application.ReferenceStyle
Application.ReferenceStyle = xlA1
ActiveSheet.UsedRange.SpecialCells(xlFormulas).Replace "$", "", xlPart
Application.ReferenceStyle = iRefStyle | |
| With Application
iRefStyle = .ReferenceStyle
.ReferenceStyle = xlA1
.Range("A1:C100").SpecialCells(xlFormulas).Replace "$", "", xlPart
.ReferenceStyle = iRefStyle
End With |
Если же Вам нужна более сложная конвертация, то обратите внимание на
вышеопубликованный [FAQ679]
Ответ :
Если Вам необходимо, сразу после выделения одной ячейки,
содержащей формулу, автоматически поместить текст этой формулы в
буфер обмена, то скопируйте весь нижеприведённый код в модуль
книги ThisWorkbook(ЭтаКнига) и сохраните изменения.
'Необходима ссылка Microsoft Forms 2.0 Object Library
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Target.HasFormula Then Exit Sub
With New DataObject
.SetText Target.FormulaLocal
.PutInClipboard
End With
End Sub | |
или
| 'Необходима следующая ссылка Microsoft Forms 2.0 Object Library
Private iClipboard As New MSForms.DataObject
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Target.HasFormula Then Exit Sub
iClipboard.SetText Target.FormulaLocal
iClipboard.PutInClipboard
End Sub |
Комментарий : Если формула окажется скрыта, а рабочий лист Sh
защищён, то Вы, разумеется, получите ошибку, которой можно избежать,
если добавить соответствующую проверку.
Ответ :
Скопируйте нижеопубликованную пользовательскую функцию (UDF)
в любой стандартный модуль книги. Затем выделите необходимый диапазон.
Не забывая, что этот диапазон может содержать несколько строк и/или
столбцов, после чего введите =RAND_UNIQUE() и обязательно
завершите ввод нажатием клавиш CTRL+SHIFT+ENTER
Public Function Rand_Unique() 'As Variant
Dim iRow&, iColumn&, iCount&, i&, iArr 'As Variant
Dim iDiapazon As Range, iCollection As New Collection
Set iDiapazon = Application.Caller
iRow = iDiapazon.Rows.Count
iCount = iDiapazon.Columns.Count
ReDim iArr(1 To iRow, 1 To iCount)
For i = 1 To iDiapazon.Count
iCollection.Add i, CStr(i)
Next
Randomize 'Timer
For iRow = 1 To iRow
For iColumn = 1 To iCount
i = Int((iCollection.Count * Rnd) + 1)
iArr(iRow, iColumn) = iCollection(i)
iCollection.Remove i
Next
Next
Rand_Unique = iArr
End Function | |
| Public Function Rand_Unique() 'As Variant
Dim iRow&, iColumn&, iCount&, i&, iArr 'As Variant
Dim iCollection As New Collection
With Application.Caller
iRow = .Rows.Count: iCount = .Columns.Count
End With
For i = 1 To iRow * iCount
iCollection.Add i, CStr(i)
Next
ReDim iArr(1 To iRow, 1 To iCount)
Randomize 'Timer
For iRow = 1 To iRow
For iColumn = 1 To iCount
i = Int((iCollection.Count * Rnd) + 1)
iArr(iRow, iColumn) = iCollection(i)
iCollection.Remove i
Next
Next
Rand_Unique = iArr
End Function |
Ответ :
Актуально только для MS Excel 95-2003
Если Вы используете формулы, то, возможно, замечали, что
иногда они возвращают значения ошибки. И если наличие таких ошибок
недопустимо, то избавиться от них можно и без программирования
[FAQ]
Причём,
там даже есть совет, как избавиться от громоздкой формулы, но это
решение имеет и свой минус, создавая именованную формулу мы теряем
наглядность, читабельность и лёгкость отладки, т.к. для любой правки
нам придётся сначала вызывать диалоговое окно и править формулу там.
Или же, сначала вызывать диалоговое окно, оттуда копировать формулу
в ячейку, в ячейке править, а затем замещать старую формулу на новую.
В общем, если речь идёт о серьёзной правке, а в книге и так
наличествуют макросы, то решить задачу можно и с помощью
пользовательской функции (UDF)
Public Function IfError(Formula, ValueError)
If Not IsError(Formula) Then
IfError = Formula
Else
IfError = ValueError
End If
End Function | |
или
| Public Function IfError(Formula, ValueError)
IfError = IIf(IsError(Formula), ValueError, Formula)
End Function |
Примеры вызова этой функции :
=IFERROR(ВПР(C1;G:J;3;0);0)
=IFERROR(B2/C2;0)
=IFERROR(ПОИСКПОЗ(C1;M:M;0);"")
Важно : Начиная с версии 2007 в наличии такой функции
уже нет необходимости, т.к. там появилась аналогичная
стандартная функция рабочего листа =ЕСЛИОШИБКА()
Ответ :
Актуально только для MS Excel 95-2010
Если возникла необходимость определить с помощью функции,
содержит ячейка формулу или нет, то можно воспользоваться этим
[FAQ]
советом и вообще обойтись без VBA. Тем более, что несомненным
плюсом использования макрофункции ПОЛУЧИТЬ.ЯЧЕЙКУ будет то, что
в версиях Excel95, 97 и 2000 Вы не будете получать сообщений о
наличии в открываемой книге макросов. Однако, времена использования
тех версий уже прошли, а начиная с в версии Excel XP(2002) такое
сообщения, уже станет нормой, поэтому, для решения поставленной
задачи, можно использовать и пользовательскую функцию (UDF)
Public Function IsFormula(Source As Range) As Boolean
IsFormula = Source.HasFormula
End Function |
Обратите внимание на то, что эта функция применима, как для
определения наличии формулы в одной единственной ячейке, так и
в диапазоне ячеек.
Но нужно иметь ввиду, что используемое свойство
.HasFormula применительно к диапазону ячеек, возвращает :
1) TRUE (ИСТИНА) если все ячейки содержат формулы
2) FALSE (ЛОЖЬ) если ни в одной из ячеек нет формулы
3) NULL (#ЗНАЧ!) если часть ячеек содержат формулы, а хотя бы одна - нет.
Если убрать As Boolean, или заменить на As Variant, что одно и тоже,
то в этом случае, функция будет возвращать не значение ошибки,
а 0, но это не есть хорошо, поэтому выбран вариант именно с #ЗНАЧ!
Если же, необходимо получить массив логических значений,
то следующий вариант функции, сможет это реализовать :
|
Public Function IsFormula(Source As Range) 'As Variant
Dim iRow&, iColumn&, iCount&, iArr() As Boolean
iRow = Source.Rows.Count
iCount = Source.Columns.Count
ReDim iArr(1 To iRow, 1 To iCount)
For iRow = 1 To iRow
For iColumn = 1 To iCount
iArr(iRow, iColumn) = Source(iRow, iColumn).HasFormula
Next
Next
IsFormula = iArr
End Function |
Только не забывайте, что это формула массива, поэтому,
для получения визуально-ожидаемого результата, нужно выделить
диапазон, совпадающий с указанным и обязательно завершить
ввод нажатием клавиш CTRL+SHIFT+ENTER. Разумеется,
эта функция может быть применена и к одной ячейке, в этом
случае вводить её, как массивную, вовсе не обязательно.
Важно : Начиная с версии 2013 в наличии такой функции
уже нет необходимости, т.к. там появилась аналогичная
стандартная функция рабочего листа =ЕФОРМУЛА()
|
|
|
|
|
| |
|
Воспроизведение любых опубликованных здесь материалов возможно только с
письменного разрешения автора :