我根据最左列中的值将多行组合成一行。 这是我正在使用的表格:
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
我可以改变什么来获得我想要的结果?
答案 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