VBA中如何将多个选择列连成一列？

Question

我想做一个excel宏，要求用户选择列进行连接，并将连接结果写在选定的列中。例如，我有A、B、C、D、E列，每列有5行。我希望有一个输入框，可以选择整个列，或者列的第一个单元格，然后它循环通过所有剩余的单元格，并将结果放在另一个选择范围列的第一个单元格中。如果我选择列Acell A1 & 列Ccell C1和列F作为目标范围，它将帮助我循环通过A1到A5 & C1到C5，并将结果放在F1(A1&C1)到F5(A5&C5)中。

我已经找到了类似这样的东西。但是，这只对单个单元格有效，但不做循环。谁能帮我一把？

Sub MergeCells()

    Dim xJoinRange As Range
    Dim xDestination As Range

    Set xJoinRange = Application.InputBox(prompt:="Highlight source cells to merge", Type:=8)
    Set xDestination = Application.InputBox(prompt:="Highlight destination cell", Type:=8)
    temp = ""
    For Each Rng In xJoinRange
        temp = temp & Rng.Value & " "
    Next
    xDestination.Value = temp
End Sub

Answer 1

试试下面这个。概念是逐行查看该行是否需要输出，通过使用 Intersect 函数。另外，检查该行中是否有任何被选中的连接。即使选择了多列，也只会写入目标范围的第一列。

    Sub MergeCell2()

    Dim xJoinRange As Range
    Dim xDestination As Range

    Set xJoinRange = Application.InputBox(prompt:="Highlight source cells to merge", Type:=8)
    Set xDestination = Application.InputBox(prompt:="Highlight destination cell", Type:=8)

     ' find 1st and last row

    Dim iRow1 As Long, iRowLast As Long
    Dim Rng As Variant

    iRow1 = 9999999
    iRowLast = 0

    For Each Rng In xJoinRange
        If Rng.Row < iRow1 Then iRow1 = Rng.Row
        If Rng.Row > iRowLast Then iRowLast = Rng.Row
    Next

    Dim rThisRange As Range
    Dim rDestCell As Range
    Dim i As Long
    Dim temp As Variant

    For i = iRow1 To iRowLast
        Set rDestCell = Intersect(xDestination, Rows(i))  ' see if output is required in this row
        If Not rDestCell Is Nothing Then
            Set rThisRange = Intersect(xJoinRange, Rows(i)) ' see if anything is selected in this row
            If Not rThisRange Is Nothing Then
                temp = ""
                For Each Rng In rThisRange
                    temp = temp & Rng.Value & " "
                Next
                rDestCell(1).Value = temp  ' (1) to write only the 1st column of dest range
            End If
        End If
    Next

End Sub