How to assign a name to an Excel cell using VBA?

I need to assign a unique name to a cell which calls a particular user defined function.

I tried

Dim r As Range
set r = Application.Caller

r.Name =开发者_Python百科 "Unique"

---

The following code sets cell A1 to have the name 'MyUniqueName':

Private Sub NameCell()

Dim rng As Range
Set rng = Range("A1")
rng.Name = "MyUniqueName"

End Sub

Does that help?

EDIT

I am not sure how to achieve what you need in a simple way, elegant way. I did manage this hack - see if this helps but you'd most likely want to augment my solution.

Suppose I have the following user defined function in VBA that I reference in a worksheet:

Public Function MyCustomCalc(Input1 As Integer, Input2 As Integer, Input3 As Integer) As Integer

MyCustomCalc = (Input1 + Input2) - Input3

End Function

Each time I call this function I want the cell that called that function to be assigned a name. To achieve this, if you go to 'ThisWorkbook' in your VBA project and select the 'SheetChange' event then you can add the following:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Left$(Target.Formula, 13) = "=MyCustomCalc" Then
    Target.Name = "MyUniqueName"
End If
End Sub

In short, this code checks to see if the calling range is using the user defined function and then assigns the range a name (MyUniqueName) in this instance.

As I say, the above isn't great but it may give you a start. I couldn't find a way to embed code into the user defined function and set the range name directly e.g. using Application.Caller.Address or Application.Caller.Cells(1,1) etc. I am certain there is a way but I'm afraid I am a shade rusty on VBA...

---

I used this sub to work its way across the top row of a worksheet and if there is a value in the top row it sets that value as the name of that cell. It is VBA based so somewhat crude and simple, but it does the job!!

Private Sub SortForContactsOutlookImport()

    Dim ThisCell As Object
    Dim NextCell As Object
    Dim RangeName As String

    Set ThisCell = ActiveCell
    Set NextCell = ThisCell.Offset(0, 1)

    Do
        If ThisCell.Value <> "" Then
            RangeName = ThisCell.Value
            ActiveWorkbook.Names.Add Name:=RangeName, RefersTo:=ThisCell
            Set ThisCell = NextCell
            Set NextCell = ThisCell.Offset(0, 1)
        End If

    Loop Until ThisCell.Value = "Web Page"

End Sub

---

I use this sub, without formal error handling:

Sub NameAdd()

    Dim rng As Range
    Dim nameString, rangeString, sheetString As String

    On Error Resume Next

    rangeString = "A5:B8"
    nameString = "My_Name"
    sheetString = "Sheet1"

    Set rng = Worksheets(sheetString).Range(rangeString)

    ThisWorkbook.Names.Add name:=nameString, RefersTo:=rng

End Sub

To Delete a Name:

Sub NameDelete()
    Dim nm As name

    For Each nm In ActiveWorkbook.Names
        If nm.name = "My_Name" Then nm.Delete
   Next

End Sub