将单元格范围粘贴到多行中的单个单元格

时间:2018-08-09 07:03:41

标签: excel vba

我正在尝试将一系列单元格粘贴到Excel中的一个单元格中。

FILE_APPEND

这是输出
Sample Image

这是我想要的输出
Sample Image

4 个答案:

答案 0 :(得分:0)

更改为换行符即可使用-我已经使用您的代码对其进行了测试。

strMerge = strMerge & Chr(10) & MyCell.Value

或完成...

strMerge = strMerge & Chr(13) & Chr(10) & MyCell.Value

已编辑以添加宏

Range("C1").Select
    With Selection
        .FormulaR1C1 = "=CONCATENATE(RC[-2],RC[-1]) &  CHAR(10) & CHAR(13) & CONCATENATE(R[1]C[-2],R[1]C[-1])"
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
    End With
End Sub

答案 1 :(得分:0)

我在Excel中使用公式对此表示满意。这是不使用VBA

m = [[(0, 0, 0), 337.94174378689814],
     [(0, 0, 1), 339.92776762374007],
     [(0, 0, 2), 338.78632729456444],
     [(0, 1, 0), 344.85997106879347],
     [(0, 1, 1), 331.6819890120493],
     [0, 0]]

for r in m:
    if [0,0] in r:
        m.remove(r)

答案 2 :(得分:0)

猜猜这解决了我的vba问题,请原谅不良的编程风格和命名 调用两个foreach循环并加入它们(用Chr(10)分隔它们)

Sub MergeSelectedRowData()

Dim MyCell As Range
Dim strMerge As String

Dim MyCell2 As Range
Dim strMerge2 As String

For Each MyCell In Sheets("Sheet1").Range("A1:B1")

    If strMerge = "" Then
        strMerge = MyCell.Value
    Else
        strMerge = strMerge & Chr(32) & MyCell.Value
    End If

Next MyCell

For Each MyCell2 In Sheets("Sheet1").Range("A2:B2")

    If strMerge2 = "" Then
        strMerge2 = MyCell2.Value
    Else
        strMerge2 = strMerge2 & Chr(32) & MyCell2.Value
    End If

Next MyCell2

Cells(1, 3).Value = strMerge & Chr(10) & strMerge2

结束子

答案 3 :(得分:0)

这是我想到的最终代码,应该可以输出期望的结果

Sub MergeSelectedRowData2()

Dim MyCell As Range
Dim strMerge(1 To 2) As Variant
Dim finalStr As String

Dim i As Integer

For i = 1 To 2

    For Each MyCell In Sheets("Sheet1").Range("A" & i & ":" & "B" & i)

        If strMerge(i) = "" Then
            strMerge(i) = MyCell.Value
        Else
            strMerge(i) = strMerge(i) & "   " & MyCell.Value
        End If

    Next MyCell

    If finalStr = "" Then
        finalStr = strMerge(i)
    Else
        finalStr = finalStr & Chr(10) & strMerge(i)
    End If

Next

Cells(1, 3).Value = finalStr

结束子