Question

在excel中，我想使用宏将日期从一张纸复制到另一张，以便将所有内容复制到第9行，然后它将跳过第10行并复制第11行和第12行，然后再跳过一张。

所以它不应该复制第10,13,16,19行等。

我有以下代码

Dim i As Integer
i = 9
J = 1
K = 9

Do While i < 5000
    If J = 3 Then
        J = 0
        Sheets("sheet1").Select
        Rows(i).Select
        Selection.Copy
        Sheets("sheet2").Select
        Cells(K, 1).Select
        ActiveSheet.Paste
        K = K + 1
    End If

    J = J + 1
    i = i + 1
Loop

此代码将所有内容复制到第8行，然后每隔3行，有人可以帮我修改该代码吗？

Answer 1

最快的方式是复制＆gt;＆gt;根据您的条件，整行一次。

您可以通过将我需要复制的所有行合并到Range对象，在我的代码中CopyRng来实现它，然后使用Application.Union执行此操作

<强>代码

Option Explicit

Sub CopyCertailRows()

Dim i As Long
Dim CopyRng As Range

Application.ScreenUpdating = False

With Sheets("sheet1")
    ' first add the first 8 rows to the copied range
    Set CopyRng = .Rows("1:8")

    For i = 9 To 5000
        If (i / 3) - Int(i / 3) <> 0 Then ' don't add to copied range the rows that divide by 3 without a remainder
            Set CopyRng = Application.Union(CopyRng, .Rows(i))
        End If
    Next i
End With

' copy >> paste in 1- line
CopyRng.Copy Destination:=Sheets("sheet2").Range("A9")

Application.ScreenUpdating = True

End Sub

Answer 2

代码中的所有必要注释：

'declare all variables, be consistent with lower/uppercases, use Long instead of Integeer (its stored as long anyway)
'use meaningful variable names
Dim i As Long, copyUntil As Long, currentRow As Long
copyUntil = 9
currentRow = 1
'copy all rows until we reach 9th row
For i = 1 To copyUntil
    Sheets("sheet1").Rows(i).Copy
    Sheets("sheet2").Rows(currentRow).Paste
    currentRow = currentRow + 1
Next
'now we will takes steps by 3, on every loop we will copy i-th row and next one, third will be omitted
'we also use currentRow variable to avoid empty rows in sheet2
'also, 5000 seems wrong, I'd recommend to determine last row, until which we will loop
'last row is often determined like Cells(Rows.Count, 1).End(xlUp).Row
For i = copyUntil + 2 To 5000 Step 3
    Sheets("sheet1").Rows(i).Copy
    Sheets("sheet2").Rows(currentRow).Paste
    currentRow = currentRow + 1
    Sheets("sheet1").Rows(i + 1).Copy
    Sheets("sheet2").Rows(currentRow).Paste
    currentRow = currentRow + 1
Next

Answer 3

您可以使用If i < 10 Or (i - 1) Mod 3 <> 0 Then...来大规模简化此操作，这会选择您感兴趣的行。就像这样：

Dim i As Integer, j As Integer
j = 0

Dim sourceSht As Worksheet
Dim destSht As Worksheet
Set sourceSht = Sheets("Sheet1")
Set destSht = Sheets("Sheet2")

For i = 1 To 5000
    If i < 10 Or (i - 1) Mod 3 <> 0 Then
        j = j + 1
        sourceSht.Rows(i).Copy destSht.Rows(j)
    End If
Next

就个人而言，我会在运行之前关闭屏幕更新和计算，然后再次启用它们以减少执行循环所需的时间。

此外，正如Michał建议的那样，除非您的数据集恰好是5,000行，否则您可能希望在开始进一步缩短所需时间之前“找到”最后一行数据。

Answer 4

此代码仅粘贴值。如果有任何问题，请告诉我，或者如果您真的需要格式化，我可以调整它。

Sub DoCopy()
    'This code is pretty much specifit to your request/question, it will copy 1-9, skip 10, 13, 16....
    'i for the loop, x for the row that will not be added, y to paste on the second sheet
    Dim i, x, y As Long, divn As Integer
    For i = 1 To 5000
        If i < 10 Then
            y = y + 1
            Sheets("Sheet1").Rows(i).Copy
            Sheets("Sheet2").Range("A" & y).PasteSpecial ''Paste values only
        ElseIf i >= 10 Then
            x = i - 10
            If x Mod 3 <> 0 Then
                y = y + 1
                Sheets("Sheet1").Rows(i).Copy
                Sheets("Sheet2").Range("A" & y).PasteSpecial ''Paste values only
            Else
                'Do nothing
            End If
        End If
    Next i
End Sub

如何复制除第n

4 个答案: