首页 > 解决方案 > 循环遍历三列和复制行(3列)然后循环到下一组3列

问题描述

*我正在编写一个宏,该宏将预订假期一张纸并将其编译到另一张纸的一列中。< 每个月有 3 列(a、b、c)。然后下个月是 (d,e,f),在工作表上移动,直到 (AJ) 列 a *日期列 b * 所花费的小时数 comn c *同意/拒绝。下个月将是 Column * date< column * hours comn * 同意/拒绝。如果列 (b) 大于 0.1 小时,它只会复制该行已经编写代码循环通过第一个月,但是我如何让它从左到右循环通过接下来的 11 个月(11 组三列)?*

Sub CopyACross()

Dim lastrow As Long, i As Long, erow As Long,

lastrow = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To lastrow

Sheets("sheet1").Select


If cells(i, 2).Value > 0.1 Then

Range(cells(i, 1), cells(i, 3)).Select
Selection.Copy

Sheets("sheet4").Select

erow = ActiveSheet.cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.cells(erow, 1).Select
ActiveSheet.Paste
End If
Next i



End Sub

标签: excelvba

解决方案


您只需将现有代码嵌入另一个对列进行计数的循环中。下面的代码未经测试。请提醒我它可能包含的任何错别字。

Sub CopyAcross()
    ' 015

    Dim WsTarget As Worksheet
    Dim lastRow As Long, R As Long, eRow As Long
    Dim C As Long

    Set WsTarget = Worksheets("Sheet4")
    With WsTarget
        ' count the rows in the same sheet where you set the range
        eRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With

    For C = 0 To 11
        With Worksheets("Sheet1")
            ' count the rows in the same sheet where you set the range
            lastRow = .Cells(.Rows.Count, (C * 3 + 1)).End(xlUp).Row

            For R = 2 To lastRow
            '    Sheets("sheet1").Select        ' don't Select anything
                If .Cells(R, (C * 3 + 2)).Value > 0.1 Then
                    eRow = eRow + 1
                    .Range(.Cells(R, (C * 3 + 1)), .Cells(R, (C * 3 + 3))).Copy _
                            Destination:=WsTarget.Cells(eRow, 1)
                End If
            Next R
        End With
    Next C
End Sub

我冒昧地删除了您的代码所做的所有选择。它们不是必需的,只会在减慢执行速度的同时增加代码量。


推荐阅读