将来自不同行的值组合成单行

时间:2016-02-03 23:59:48

标签: excel-vba vba excel

我根据最左列中的值将多行组合成一行。 这是我正在使用的表格:

Example1    1   2                   1
Example1    1   2   3               2
Example1            3   4           3
Example1                4   5       4
Example1    2               5   6   5
Example1                        6   6
Example1                            7
Example2    7   8                   8
Example2        8   9               9
Example2            9   10          10
Example2                10  11      11
Example2                    11  12  12
Example2                        12  13
Example2                            14
Example2                            15
Example2                            16
Example2                            17
Example3                            18
Example4    13  14                  19
Example4        14  15              20
Example4            15  16          21
Example4                16  17      22
Example4                    17  18  23
Example4                        18  24
Example4                            25
Example4                            26
Example4                            27
Example4                            28

这是我得到的:

Example1        2   3   4   5   6
Example2        8   9   10  11  12
Example3        8   9   10  11  12
Example4        14  15  16  17  18

这就是我想要的:

Example1        2   3   4   5   6
Example2        8   9   10  11  12
Example3                        
Example4        14  15  16  17  18

以下是代码:

Sub sprt()

    Dim h As Integer
    Dim i As Integer
    Dim j As Integer
    Dim a As Integer
    Dim b As Integer
    Dim MyArray(8) As String
    Dim MyArray2(100, 8) As String

    a = 0
    b = 0

    For i = 1 To 28
    For j = 1 To 7

    Sheets("Sheet6").Activate

    If Cells(i, j) <> "" Then
        MyArray(j) = Cells(i, j).value
    End If

    Next

    If i = 1 Then b = 1

    If i > 1 Then

    If Cells(i, 1) <> Cells(i - 1, 1) Then b = b + 1

    End If

    For j = 1 To 7
        MyArray2(b, j) = MyArray(j)

    Next

    Next
    For i = 1 To b

    For j = 1 To 7

    a = 10

    Cells(i, j + a) = MyArray2(i, j)

    Next

    Next 

我可以改变什么来获得我想要的结果?

1 个答案:

答案 0 :(得分:1)

考虑到@ScottCarner的建议,我已经改组你的代码并尝试过,它运行良好。

Sub sprt()

    Dim h As Integer
    Dim i As Integer
    Dim j As Integer
    Dim a As Integer
    Dim b As Integer
    Dim MyArray(8) As String
    Dim MyArray2(100, 8) As String
    a = 0
    b = 0
    Sheets("Sheet2").Activate
    For i = 1 To 28

        If i = 1 Then b = 1
        If i > 1 Then
            If Cells(i, 1) <> Cells(i - 1, 1) Then
                b = b + 1
                Erase MyArray
            End If
        End If

        For j = 1 To 7

            If Cells(i, j) <> "" Then
                MyArray(j) = Cells(i, j).Value
            End If

        Next

        For j = 1 To 7
            MyArray2(b, j) = MyArray(j)
        Next
    Next

    For i = 1 To b
        For j = 1 To 7
            a = 10
            Cells(i, j + a) = MyArray2(i, j)
        Next
    Next
End Sub