帮忙用VBA解决一个问题，自己想了好几天没有好方法。

johnhu

请教各个专家，我这里有个这么个实际情况附表1，一个表，A列、B列、C列、D列、F列、一般情况是除了B列，其它都有数据，当C列的一行数据放不下时，它的数据会放到下面连接的一行或几行。这时，D、F列的数据就放在与C列最后一行平行的那一行。现在要求把C列放在下面若干行的数据与第一行数据合并，D、F列数据移动回到一行。最终结果看附件表2。请各位专家看看用VBA如何实现。

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   With Worksheets("sheet1")
   
5.     r = .Cells(.Rows.Count, 3).End(xlUp).Row
   
6.     arr = .Range("a3:e" & r)
   
7.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
8.     m = 0
   
9.     For i = 1 To UBound(arr)
   
10.       If Len(arr(i, 1)) <> 0 Then
    
11.         m = m + 1
    
12.         For j = 1 To UBound(arr, 2)
    
13.           brr(m, j) = arr(i, j)
    
14.         Next
    
15.       Else
    
16.         brr(m, 3) = brr(m, 3) & arr(i, 3)
    
17.         brr(m, 4) = brr(m, 4) & arr(i, 4)
    
18.         brr(m, 5) = brr(m, 5) & arr(i, 5)
    
19.       End If
    
20.     Next
    
21.   End With
    
22.   With Worksheets("sheet2")
    
23.     .Range("a15").Resize(m, UBound(brr, 2)) = brr
    
24.   End With
    
25. End Sub
    

复制代码

chxw68

详见附件。

pshl7

For m = Cells(65536, "C").End(xlUp).Row To 1 Step -1
        If Cells(m, "A").Value = "" Then
            vlu = Cells(m, "C").Value & " " & vlu
            If Cells(m, "D").Value <> "" Then vlu2 = Cells(m, "D").Value
            If Cells(m, "E").Value <> "" Then vlu3 = Cells(m, "E").Value
            Rows(m).Delete
        Else
            If vlu <> "" Then
                Cells(m, "C").Value = Cells(m, "C").Value & " " & vlu
                Cells(m, "D").Value = vlu2
                Cells(m, "E").Value = vlu3
                vlu = ""
            End If
        End If
    Next m