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 在 Functions 中不可用。

我确实阅读了一种返回变体而不是字符串的方法，但它涉及 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