Question

我正在尝试将C：AH中的一系列单元格的内容复制到下面的行中。

这个子嵌套在另一个中，它将循环并在所有这一行下面输入另一行。

到目前为止我有以下内容

Sub RowDiv1()

Dim Leg1 As Range
Dim Leg2 As Range
Dim Leg3 As Range
Dim Leg4 As Range
Dim Leg5 As Range
Dim Leg6 As Range
Dim Leg7 As Range
Dim Leg8 As Range

Dim C1 As Range

With Worksheets("Working Sheet 1")
    Set Leg1 = .Range(.Range("C6000").End(xlUp), .Range("AH6000").End(xlUp))
    With Leg1
        .Cut
    End With

Set C1 = .Range("C6000").End(xlUp).Offset(1, -2)
    With C1
        'This is the paste line that is causing a problem
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End With
End With

End Sub

正如你所看到的，这是8条腿中的第一条腿的切口。我打算重复这段代码，以便将同一条线切断8次。

这是我的一行代码

的示例

18-Apr-17|  11:00:30|   Walker1_Leg1|   319437.222| 146279.951| -32.768|    Walker1_Leg2|   319417.07|  146268.105| -32.768|    Walker1_Leg3|   319410.548| 146268.368| -32.768|    Walker1_Leg4|   319398.806| 146288.339| -32.768|    Walker1_Leg5|   319399.702| 146297.706| -32.768|    Walker1_Leg6|   319419.94|  146309.425| -32.768|    Walker1_Leg7|   319428.284| 146305.858| -2.533| Walker1_Leg8|   319440.055| 146285.716| -32.768

如何解决此问题？

干杯

詹姆斯

Answer 1

试一试，

Sub RowDiv1()
    With Worksheets("Working Sheet 1")
        With .Range(.Range("C6000").End(xlUp), .Range("AH6000").End(xlUp))
            .Cells(1).Offset(1, -2).Resize(.Rows.Count, .Columns.Count) = .Value
            .ClearContents
        End With
    End With
End Sub

Answer 2

您可以使用数组使其更快一点：

Sub RowDiv1()

Dim rng As Range
Dim iArr() As Variant
Dim oarr() As Variant
Dim i&, j&
ReDim oarr(1 To 8, 1 To 4) As Variant
With Worksheets("Working Sheet 1")
    Set rng = .Range(.Range("C6000").End(xlUp), .Range("AH6000").End(xlUp))
    iArr = rng.Value
    j = 1
    For i = LBound(iArr, 2) To UBound(iArr, 2) Step 4
        oarr(j, 1) = iArr(1, i)
        oarr(j, 2) = iArr(1, i + 1)
        oarr(j, 3) = iArr(1, i + 2)
        oarr(j, 4) = iArr(1, i + 3)
        j = j + 1
    Next i
    .Range("A6000").End(xlUp).Offset(1).Resize(8, 4).Value = oarr
    rng.ClearContents

End With

PasteSpecial导致错误

2 个答案: