Question

我正在尝试将所有非空白单元格从一张纸张复制并粘贴到另一张纸张上。目前我已经设法提出这个代码来做到这一点。

For i = 17 To 29

'CBCC'

    If Not IsEmpty(Worksheets("Trends (N)").Range("B" & i)) Then _
        Worksheets("Trends").Range("B" & i - 10) = Worksheets("Trends (N)").Range("B" & i)
    If Not IsEmpty(Worksheets("Trends (N)").Range("C" & i)) Then _
        Worksheets("Trends").Range("C" & i - 10) = Worksheets("Trends (N)").Range("C" & i)
    If Not IsEmpty(Worksheets("Trends (N)").Range("D" & i)) Then _
        Worksheets("Trends").Range("D" & i - 10) = Worksheets("Trends (N)").Range("D" & i)
    If Not IsEmpty(Worksheets("Trends (N)").Range("E" & i)) Then _
        Worksheets("Trends").Range("E" & i - 10) = Worksheets("Trends (N)").Range("E" & i)
    If Not IsEmpty(Worksheets("Trends (N)").Range("F" & i)) Then _
        Worksheets("Trends").Range("F" & i - 10) = Worksheets("Trends (N)").Range("F" & i)

'ECAC'

    If Not IsEmpty(Worksheets("Trends (N)").Range("I" & i)) Then _
        Worksheets("Trends").Range("H" & i - 10) = Worksheets("Trends (N)").Range("I" & i)
    If Not IsEmpty(Worksheets("Trends (N)").Range("J" & i)) Then _
        Worksheets("Trends").Range("I" & i - 10) = Worksheets("Trends (N)").Range("J" & i)
    If Not IsEmpty(Worksheets("Trends (N)").Range("K" & i)) Then _
        Worksheets("Trends").Range("J" & i - 10) = Worksheets("Trends (N)").Range("K" & i)
    If Not IsEmpty(Worksheets("Trends (N)").Range("L" & i)) Then _
        Worksheets("Trends").Range("K" & i - 10) = Worksheets("Trends (N)").Range("L" & i)
    If Not IsEmpty(Worksheets("Trends (N)").Range("M" & i)) Then _
        Worksheets("Trends").Range("L" & i - 10) = Worksheets("Trends (N)").Range("M" & i)

'Impairment'

    If Not IsEmpty(Worksheets("Trends (N)").Range("P" & i)) Then _
        Worksheets("Trends").Range("N" & i - 10) = Worksheets("Trends (N)").Range("P" & i)
    If Not IsEmpty(Worksheets("Trends (N)").Range("Q" & i)) Then _
        Worksheets("Trends").Range("O" & i - 10) = Worksheets("Trends (N)").Range("Q" & i)
    If Not IsEmpty(Worksheets("Trends (N)").Range("R" & i)) Then _
        Worksheets("Trends").Range("P" & i - 10) = Worksheets("Trends (N)").Range("R" & i)
    If Not IsEmpty(Worksheets("Trends (N)").Range("S" & i)) Then _
        Worksheets("Trends").Range("Q" & i - 10) = Worksheets("Trends (N)").Range("S" & i)
     If Not IsEmpty(Worksheets("Trends (N)").Range("T" & i)) Then _
        Worksheets("Trends").Range("R" & i - 10) = Worksheets("Trends (N)").Range("T" & i)

'Total'

    If Not IsEmpty(Worksheets("Trends (N)").Range("V" & i)) Then _
        Worksheets("Trends").Range("T" & i - 10) = Worksheets("Trends (N)").Range("V" & i)
    If Not IsEmpty(Worksheets("Trends (N)").Range("W" & i)) Then _
        Worksheets("Trends").Range("U" & i - 10) = Worksheets("Trends (N)").Range("W" & i)
    If Not IsEmpty(Worksheets("Trends (N)").Range("X" & i)) Then _
        Worksheets("Trends").Range("V" & i - 10) = Worksheets("Trends (N)").Range("X" & i)
    If Not IsEmpty(Worksheets("Trends (N)").Range("Y" & i)) Then _
        Worksheets("Trends").Range("W" & i - 10) = Worksheets("Trends (N)").Range("Y" & i)
    If Not IsEmpty(Worksheets("Trends (N)").Range("Z" & i)) Then _
        Worksheets("Trends").Range("X" & i - 10) = Worksheets("Trends (N)").Range("Z" & i)

'End Import'

Next i

这显然效率不高，如果我需要使用更大的数据集来完成它，则需要很长时间。

我尝试了其他一些方法，但他们似乎并没有产生我需要的结果。

有没有人有任何建议？我现在是VBA的新秀。

Answer 1

Dim ws(1) As Worksheet
Set ws(0) = Worksheets("Trends (N)") 'sheet you export from
Set ws(1) = Worksheets("Trends") 'sheet you export to
For i = 17 To 29

'CBCC'
For j = 2 To 6 'B to F
If Not IsEmpty(ws(0).Cells(i, j)) Then _
    ws(1).Cells(i - 10, j).Value2 = ws(0).Cells(i, j).Value2
Next j

'ECAC'
For j = 9 To 13 'I to M
If Not IsEmpty(ws(0).Cells(i, j)) Then _
    ws(1).Cells(i - 10, j - 1).Value2 = ws(0).Cells(i, j).Value2
Next j

'Impairment'
For j = 16 To 20 'P to T
If Not IsEmpty(ws(0).Cells(i, j)) Then _
    ws(1).Cells(i - 10, j - 2).Value2 = ws(0).Cells(i, j).Value2
Next j

'Total'
For j = 22 To 26 'V to Z
If Not IsEmpty(ws(0).Cells(i, j)) Then _
    ws(1).Cells(i - 10, j - 2).Value2 = ws(0).Cells(i, j).Value2
Next j

'End Import'

Next i

优化此复制和粘贴过程

1 个答案: