Excel自定义函数填充行

Question

我有一个自定义的excel函数'GetADUser'，该函数以用户名作为输入，返回多个Active Directory属性，例如名字，姓氏，SAM帐户名，专有名称。

如何将这些属性放入保存论坛的单元格左右两侧的单元格中。即：

Public Function GetADUser(UserName As String) As String

Dim mycell As Range

Set rootDSE = GetObject("LDAP://RootDSE")

Base = "<LDAP://" & rootDSE.Get("defaultNamingContext") & ">"
'filter on user objects with the given account name
fltr = "(&(objectClass=user)(objectCategory=Person)" & _
        "(sAMAccountName=" & UserName & "))"
'add other attributes according to your requirements
attr = "distinguishedName,sn,mobile,sAMAccountName,GivenName,l,postOfficeBox"
Scope = "subtree"

Set conn = CreateObject("ADODB.Connection")
conn.Provider = "ADsDSOObject"
conn.Open "Active Directory Provider"

Set cmd = CreateObject("ADODB.Command")
Set cmd.ActiveConnection = conn
cmd.CommandText = Base & ";" & fltr & ";" & attr & ";" & Scope

  Set rs = cmd.Execute

  arrPOBox = rs.Fields("postOfficeBox").Value
  Rank = CStr(arrPOBox(0))

  ActiveCell.Offset(0, -1).Value = (rs.Fields("sn").Value)
  ActiveCell.Offset(0, -2).Value = (rs.Fields("GivenName").Value)
  ActiveCell.Offset(0, 2).Value = (rs.Fields("l").Value)
  ActiveCell.Offset(0, 1).Value = (rs.Fields("mobile").Value)

rs.Close
conn.Close

GetADUser = GetADUser

End Function

但是ActiveCell在功能中不可用。

我确实读过一种返回变量而不是String的方法，但是它涉及到CTRL-SHIFT-ENTER来拆分值，所有值都保存在包含公式的单元格的右侧。我不想为每个单元调用Active Directory。

是否存在可以实现的功能或过程，以便当用户退出用户名列中的单元格时，将填充其他相对单元格。

更新

应该在原始问题中对此进行详细说明，但是用户名单元格可以在工作簿的任何工作表中，而不能在四个可能的列中的一个连续单元格集中。 （例如，请参见黄色单元格）

工作表名称也可以更改。

Intersect method的范围限制为（30）。

我考虑使用正则表达式，因为用户名始终为[a-z] {4} [a-z] {2}，但随后会在每个单元格上触发。

我将如何相交？

Answer 1

类似这样的东西：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, c As Range

    'any updates to username(s)?
    Set rng = Application.Intersect(Me.Range("C2:C1000"), Target)
    If Not rng Is Nothing Then
        Application.EnableEvents = False '<< don't re-trigger the event
        For Each c In rng.Cells
            UpdateAdInfo c  'update the row for this user
        Next c
        Application.EnableEvents = True '<< re-enable events
    End If
End Sub




Public Sub UpdateAdInfo(rngUserName As Range)

    'clear existing data
    rngUserName.EntireRow.Range("A1:B1,D1:E1").ClearContents '<< note range is relative to row, not to sheet

    If Len(rngUserName.Value) = 0 Then Exit Sub 'no username entered, or was deleted

    '...
    '...snipped for clarity: open the recordset using rngUserName.Value
    '...

    Set rs = cmd.Execute

    With rngUserName.EntireRow
        .Cells(1).Value = rs.Fields("GivenName").Value
        .Cells(2).Value = rs.Fields("sn").Value
        'etc etc
    End With

    rs.Close
    conn.Close
End Sub