在网上找到的。

Sub SingleCellAddress()
'Add Semicolon and combine cells in range into one selected cell, seperated by a semicolon and a space

Dim i As String
Dim lRow As Long
Dim rng As Range, drng As Range

    On Error Resume Next
    Set rng = Application.Selection
    Set rng = Application.InputBox("Select a range", "Select a range to combine into a single cell.", rng.Address, Type:=8)
    If Err.Number = 424 Then          'Handle cancel button
        Err.Clear
        Exit Sub
    End If
    
    On Error Resume Next
    Set drng = Application.InputBox("Select a cell to combine", "Select a cell to combine into single cell seperated by a Semicolon", Type:=8)
    If Err.Number = 424 Then          'Handle cancel button
        Err.Clear
        Exit Sub
    End If

For Each cl In rng
i = i & cl & "; "
Next cl
Range(drng.Address).Value = Trim(i)

End Sub