代码完善

Adel345

各位大神：


           如下附件，我写了一段代码，代码运行时，第八行不太对，E列放的逻辑其实是，比如把后门路的三段横向放置，代码把连接的中门路到四门路都横向放置了，我想设置一个比如B列的x跟n之间如果是有空单元格就运行，哪位大神帮我修改下，还有一个问题，感觉我的代码存在无效运行的部分，能不能帮我完善一下，跪谢！


Sub 测试()
Dim n%, x%, y%, fz As Range, zt As Range
For n = 20 To 1 Step -1
x = Cells(n, 2).End(xlUp).Row
If n - x > 1 Then  '且n跟x之间有空单元格,这句如何表示
   y = 0
    Do Until y = n - x - 1
    Set fz = Cells(x, 2).Offset(y + 1, 1).Resize(1, 2)
    Set zt = Cells(x, 2 + 2 * (y + 1)).Offset(0, 1).Resize(1, 2)
    fz.Copy zt
    y = y + 1
   
    Loop

End If
Next
End Sub

quqiyuan

参与一下，仅供参考。。。

quqiyuan

代码如下。。。
Sub test()
    arr = Sheet1.UsedRange
    ReDim brr(1 To UBound(arr), 1 To 100)
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            brr(i, j) = arr(i, j)
        Next
        n = j - 1
        If arr(i, 2) <> Empty Then
            For k = i + 1 To UBound(arr)
                If arr(k, 2) = Empty Then
                     n = n + 1: brr(i, n) = arr(k, 3): n = n + 1
                     m = Application.Max(m, n): brr(i, n) = arr(k, 4)
                Else
                    Exit For
                End If
            Next
        End If
    Next
    Sheet2.UsedRange.Clear
    Sheet2.[a1].Resize(UBound(arr), m) = brr
    Beep
End Sub

一招秒杀

用数据透视表，轻点几下鼠标就好，所见即所得，它不香吗