如何循环动态范围并将该范围内的选择信息复制到另一个工作表

时间:2014-02-11 20:32:42

标签: excel vba excel-vba dynamic range

我已经创建了一个大约160行的VBA脚本,它会生成您在下面看到的报告。

不使用单元格引用(因为每次运行时日期范围都会更改)我现在需要获取用户ID,名称,总小时数,总休息时间,加班时间1和加班时间2并将此数据复制到表单2中

关于如何构建VBA脚本以搜索行B直到找到空白的任何建议,当找到空白时,复制该行上的行J,K,L,M中的值,以及行上的值高于复制值C - 现在将这些值粘贴到工作表2上。 - 继续此过程,直到找到两个连续的空白或数据结束...

即使您可以提出一种不同的方法来解决这个问题,而不是我上面假设的逻辑,我们将不胜感激。如果您有兴趣,我可以分享整个代码,并向您展示我开始的数据。

提前谢谢你, Ĵ

Example

1 个答案:

答案 0 :(得分:1)

正如所讨论的,这是我的方法。所有细节都在代码的评论中,因此请务必阅读它们。

Sub GetUserNameTotals()

    Dim ShTarget As Worksheet: Set ShTarget = ThisWorkbook.Sheets("Sheet1")
    Dim ShPaste As Worksheet: Set ShPaste = ThisWorkbook.Sheets("Sheet2")
    Dim RngTarget As Range: Set RngTarget = ShTarget.UsedRange
    Dim RngTargetVisible As Range, CellRef As Range, ColRef As Range, RngNames As Range
    Dim ColIDIndex As Long: ColIDIndex = Application.Match("ID", RngTarget.Rows(1), 0)
    Dim LRow As Long: LRow = RngTarget.SpecialCells(xlCellTypeLastCell).Row

    'Turn off AutoFilter to avoid errors.
    ShTarget.AutoFilterMode = False

    'Logic: Apply filter on the UserName column, selecting blanks. We then get two essential ranges.
    'RngTargetVisible is the visible range of stats. ColRef is the visible first column of stats.
    With RngTarget
        .AutoFilter Field:=ColIDIndex, Criteria1:="=", Operator:=xlFilterValues, VisibleDropDown:=True
        Set RngTargetVisible = .Range("J2:M" & LRow).SpecialCells(xlCellTypeVisible)
        Set ColRef = .Range("J2:J" & LRow).SpecialCells(xlCellTypeVisible)
    End With

    'Logic: For each cell in the first column of stats, let's get its offset one cell above
    'and 7 cells to the left. This method is not necessary. Simply assigning ColRef to Column C's
    'visible cells and changing below to CellRef.Offset(-1,0) is alright. I chose this way so it's
    'easier to visualize the approach. RngNames is a consolidation of the cells with ranges, which we'll
    'copy first before the stats.
    For Each CellRef In ColRef
        If RngNames Is Nothing Then
            Set RngNames = CellRef.Offset(-1, -7)
        Else
            Set RngNames = Union(RngNames, CellRef.Offset(-1, -7))
        End If
    Next CellRef

    'Copy the names first, then RngTargetVisible, which are the total stats. Copying headers is up
    'to you. Of course, modify as necessary.
    RngNames.Copy ShPaste.Range("A1")
    RngTargetVisible.Copy ShPaste.Range("B1")

End Sub

<强>截图:

设置向上:

enter image description here

<强>结果:

enter image description here

在此演示视频:

Using Filters and Visible Cells

如果有帮助,请告诉我们。