如果你有Excel 365，你可以使用这个公式：

=LET(Names,A2:A8,FirstLetters,B2:B8,
UniqueLetters,UNIQUE(FirstLetters),
DROP(REDUCE("",UniqueLetters,LAMBDA(r,l,VSTACK(r,l,FILTER(Names,FirstLetters=l)))),1))

我做了一个函数，从一个表的一列中读取名称，a）返回一个一维数组，其中的名称也有标题，或者将结果复制到表中的某个点，您可以参数化地指定。名字是排序的。您可以根据需要调整细节。正如我在评论中所写的，你可以通过一个复杂的查询得到结果：

Public Function sqlNamesWithHeader(Optional destination As Range = Nothing) As Variant()
   Dim connection As Object, recSet As Object, sql As String, rc As Long, rslt() As Variant, c As Long
   Dim selectA As String, selectB As String
   Const table = " [SHEET07$P2:P18] "
   
   selectA = "SELECT [F1] AS NAME, LEFT(F1,1) AS LETTER FROM" & table
   selectB = "SELECT LEFT(F1,1) AS NAME, """" AS LETTER FROM" & table
   sql = "SELECT DISTINCT [NAME], [LETTER] FROM (" & selectA & " UNION ALL " & selectB & ") ORDER BY [NAME]"

   ReDim rslt(0 To 0)    ' Lbound(rslt) = 0 ==> no data
   Set connection = CreateObject("ADODB.Connection")
   With connection
      .CursorLocation = 3
      .Provider = "Microsoft.ACE.OLEDB.12.0"
      .ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" & _
      "Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"
      .Open
      Set recSet = .Execute(sql)
   End With
   If Not destination Is Nothing Then
      Call destination.CopyFromRecordset(recSet)
   Else
      rc = recSet.recordCount
      ReDim rslt(1 To rc)     ' Lbound(rslt) > 0 ==> have data
      For c = 1 To rc
         rslt(c) = recSet(0)
         recSet.MoveNext
      Next
   End If
   sqlNamesWithHeader = rslt
   recSet.Close
   connection.Close
   Set recSet = Nothing
   Set connection = Nothing
End Function

Sub tester()
   Dim v As Variant, c As Long
   'this way the result start copied at cell R1
   Call sqlNamesWithHeader(Me.Range("R1"))
   
   'this way we take an one-dimentional array with the result
   v = sqlNamesWithHeader()
   if Lbound(v) > 0 then
      For c = LBound(v) To UBound(v)
         Debug.Print v(c)
      Next
   End If
End Sub