拆分和分组

如果您有Microsoft 365，则可以使用以下各项：

=LET(FileNames,A1:A6,
    FileExtensions,TEXTAFTER(FileNames,"."),
    UniqueFileExtensions,UNIQUE(FileExtensions),
IFERROR(DROP(REDUCE("",UniqueFileExtensions,
    LAMBDA(CurrentResult,UniqueFileExtension,
    HSTACK(CurrentResult,FILTER(FileNames,FileExtensions=UniqueFileExtension)))),,1),""))

如果要添加标头，请添加TOROW和VSTACK：

=LET(FileNames,A1:A6,
    FileExtensions,TEXTAFTER(FileNames,"."),
    UniqueFileExtensions,TOROW(UNIQUE(FileExtensions)),
VSTACK(UniqueFileExtensions,IFERROR(DROP(REDUCE("",UniqueFileExtensions,
    LAMBDA(CurrentResult,UniqueFileExtension,
    HSTACK(CurrentResult,FILTER(FileNames,FileExtensions=UniqueFileExtension)))),,1),"")))

• • 编辑**
• 根据Mayukh Bhattacharya的建议，简化为TEXTAFTER。
• 删除了第一个公式中多余的TOROW。

可以使用嵌套字典

Sub test()

    With New Scripting.Dictionary
        Dim cel As Range
            For Each cel In Range("A1").CurrentRegion
                If Not .Exists(Split(cel.Value, ".")(1)) Then .Add Split(cel.Value, ".")(1), New Scripting.Dictionary
                .Item(Split(cel.Value, ".")(1)).Add cel.Value, 1
            Next
        
            Dim iK As Long
                For iK = 0 To .Count - 1
                    Range("C1").Offset(, iK).Resize(.Items(iK).Count).Value = Application.Transpose(.Items(iK).Keys)
                Next
    End With
    
End Sub

只需添加对"Microsoft脚本运行时"库的引用
第一节第一节第一节第一节第一次

使用scripting.dictionary的变体：

Sub test()

    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    dic.comparemode = vbTextCompare
    
    Dim cl As Range
    
    For Each cl In [A1:A6]
        If Not dic.exists(Split(cl.Value, ".")(1)) Then
            dic.Add Split(cl.Value, ".")(1), cl.Value
        Else
            dic(Split(cl.Value, ".")(1)) = dic(Split(cl.Value, ".")(1)) & "|" & cl.Value
        End If
    Next cl
    
    Dim x%, i%, dKey, sVal
    
    x = 3
    For Each dKey In dic
        i = 1
        For Each sVal In Split(dic(dKey), "|")
            Cells(i, x).Value = sVal
            i = i + 1
        Next sVal
        x = x + 1
    Next dKey
        
End Sub

演示：