用于命名范围的UDF函数

时间:2014-05-26 09:01:13

标签: excel vba excel-vba

我需要一个小的UDF来命名Excel中的范围,但它会不断返回#VALUE错误。做一个子作品就像魅力一样,但不是我想要的,因为我想命名大量的范围。 首先是子:

Sub setNamedRanges()
    ' input values
    inputRange = "A4"
    newName = "Tank101"

    ' removing spaces from the name
    newName = Replace(newName, " ", "")

    ' write the name
    Range(inputRange).name = newName
End Sub

现在和函数(inputRange =“A4”和newName =“Tank101”)相同,它应该在完成时返回“成功”,但根本不起作用:

Function setNamedRange(inputRange, newName)

    ' removing spaces from the name
    newName = Replace(newName, " ", "")

    ' write the name
    Range(inputRange).name = newName

    setNamedRange = "succesful"
End Function

我做错了什么?将数组读入具有所需值的子数据肯定会起作用,但不能提供完整的功能。

4 个答案:

答案 0 :(得分:3)

函数无法更改工作簿。范围是工作簿/工作表属性,因此无法通过函数进行更改。函数可以将结果返回到工作表,但这不是属性,所以没关系。在另一方面,潜艇不能返回任何东西,但他们可以修改属性。

答案 1 :(得分:1)

您可以尝试以下代码。效果很好:

Sub setNamedRanges()
    Dim newName As String
    newName = "Tank101"
    Dim inputRange As Range
    Set inputRange = Range("A4")
    inputRange.name = newName
End Sub

如果您有任何疑虑,请与我们联系。

此致

答案 2 :(得分:1)

好的,您可以尝试以下其他方式:

Sub Button1_Click()
   Call ChangeValue("Tank101", "Alibaba")
End Sub

Sub ChangeValue(cellAddress, newValue)
    Dim inputRange As Range
    Set inputRange = Range(cellAddress)
    inputRange.Name = newValue
End Sub

如果您有任何疑虑,请与我们联系。

答案 3 :(得分:0)

在Marks回答的帮助下,我找到了以下解决方案,请参阅下面的解决方案。它有点长而且不直接但它有效。致电

giveNameToRange("Tank101")
在单元格内的

给出了名称"坦克101"到这个细胞。代码是:

Private Declare Function SetTimer Lib "user32" ( _
      ByVal HWnd As Long, _
      ByVal nIDEvent As Long, _
      ByVal uElapse As Long, _
      ByVal lpTimerFunc As Long _
   ) As Long

Private Declare Function KillTimer Lib "user32" ( _
      ByVal HWnd As Long, _
      ByVal nIDEvent As Long _
   ) As Long

Private mCalculatedCells As Collection
Private mWindowsTimerID As Long
Private mApplicationTimerTime As Date

Public Function giveNameToRange(newName) As String

' This is a UDF that returns the sum of two numbers and starts a windows timer
' that starts a second Appliction.OnTime timer that performs activities not
' allowed in a UDF. Do not make this UDF volatile, pass any volatile functions
' to it, or pass any cells containing volatile formulas/functions or
' uncontrolled looping will start.

   newName = Replace(newName, " ", "")
   giveNameToRange = newName

   ' Cache the caller's reference so it can be dealt with in a non-UDF routine
   If mCalculatedCells Is Nothing Then Set mCalculatedCells = New Collection
   On Error Resume Next
   mCalculatedCells.Add Application.Caller, Application.Caller.Address
   On Error GoTo 0

   ' Setting/resetting the timer should be the last action taken in the UDF
   If mWindowsTimerID <> 0 Then KillTimer 0&, mWindowsTimerID
   mWindowsTimerID = SetTimer(0&, 0&, 1, AddressOf AfterUDFRoutine1)

End Function

Public Sub AfterUDFRoutine1()

' This is the first of two timer routines. This one is called by the Windows
' timer. Since a Windows timer cannot run code if a cell is being edited or a
' dialog is open this routine schedules a second safe timer using
' Application.OnTime which is ignored in a UDF.

   ' Stop the Windows timer
   On Error Resume Next
   KillTimer 0&, mWindowsTimerID
   On Error GoTo 0
   mWindowsTimerID = 0

   ' Cancel any previous OnTime timers
   If mApplicationTimerTime <> 0 Then
      On Error Resume Next
      Application.OnTime mApplicationTimerTime, "AfterUDFRoutine2", , False
      On Error GoTo 0
   End If

   ' Schedule timer
   mApplicationTimerTime = Now
   Application.OnTime mApplicationTimerTime, "AfterUDFRoutine2"

End Sub

Public Sub AfterUDFRoutine2()

' This is the second of two timer routines. Because this timer routine is
' triggered by Application.OnTime it is safe, i.e., Excel will not allow the
' timer to fire unless the environment is safe (no open model dialogs or cell
' being edited).

   Dim Cell As Range

   ' Do tasks not allowed in a UDF...
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   Do While mCalculatedCells.Count > 0
      Set Cell = mCalculatedCells(1)
      mCalculatedCells.Remove 1
      Cell.name = Cell.Value
   Loop
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
   End Sub