Question

我们有一个名为Shipsheet的工作簿，在该工作簿中我们有一个名为“SHIPSHEET 2015”的工作表，我们会跟踪所有发票。对于尚未支付的发票（付费栏中没有“X”的发票（H栏）），我们手动将发票添加到同一工作簿中名为“现金流”的单独工作表中，这是按时间顺序排列的。换句话说，逾期最长的发票显示在现金流工作表的顶部。我还注意到，我们对不同客户有不同的条款，我们在SHIPSHEET 2015的G栏中记录：“净10”，“净30”或“收到时到期”。

我想从SHIPSHEET 2015自动填充现金流量。我希望现金流量能够自动排序，最长的过期发票在最上面。

我在这里搜索了许多线程，这些线程显示了创建代码的各种方法，如果满足某些条件，会将行复制到另一个工作表，但我没有任何运气让他们工作。

我的参数是：

如果SHIPSHEET 2015中的H列为空白，则将该行复制到Cash Flow工作表。理想情况下，我只想将A，C，G，M和N列复制到现金流工作表中，而不需要其他工作表。
发票的截止日期取决于发票的日期（在SHIPSHEET 2015的B栏中）和G栏中的条款。因此，发票日期为2015年11月11日，净10个期限到期2015年11月25日。如上所述，我希望现金流量自动按照最长的过期发票排序。

这是我在尝试排序和复制行中特定单元格之前尝试开始的内容。

子copyrows（）

Dim tfCol As Range, Cell As Object

Set tfCol = Range("A5000:A6000")

For Each Cell In tfCol

    If IsEmpty(Cell) Then
        Cell.EntireRow.Copy
        Sheet2.Select
        ActiveSheet.Range("A65536").End(xlUp).Select
        Selection.Offset(1, 0).Select
        ActiveSheet.Paste
    End If

    If Cell.Value = "X" Then
        Exit Sub
    End If

Next

End Sub

Answer 1

您似乎正在循环检查每一行（并可选择复制它），但我希望您考虑AutoFilter Method。这是一个批量操作，通常比每行循环更快。

Sub Ship_to_CashFlow()
    Dim wsCF As Worksheet

    'set the receiving worksheet
    Set wsCF = Worksheets("Cash Flow")

    With Worksheets("SHIPSHEET 2015")
        'if the worksheet has a filter active, turn it off
        If .AutoFilterMode Then .AutoFilterMode = False

        'use the region specified by selecting A1 and tapping Ctrl+A once
        With .Cells(1, 1).CurrentRegion
            'filter for blanks in the 8th column (H)
            .AutoFilter field:=8, Criteria1:="="
            'move down one row to discard the header row
            With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
                'Are there any visible cells?
                If CBool(Application.Subtotal(103, .Cells)) Then
                    'copy them to to the next blank row in the CF worksheet
                    .Copy Destination:=wsCF.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                End If
            End With
            'turn off the filter
            .AutoFilter field:=8
        End With
    End With
End Sub

适用于Range.CurrentRegion property定义的数据区域。一系列With ... End With statement隔离了正在检查和处理的工作表区域。

排序可能需要某种“帮助”列，该列将提供一个数字，其中包含发票日期栏B和G栏中的条款。

Answer 2

谢谢......我在你的过滤器建议中有点迷失了，而我让它工作了：

Sub cond_copy()
    Sheets("2015 SHIPSHEET").Select
    RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
    Set Rng = Selection
    For i = 1 To RowCount
        Range("h" & i).Select
        check_value = ActiveCell
        If check_value = "" Or check_value = "" Then
            ActiveCell.EntireRow.Copy
            Sheets("Sheet1").Select
            RowCount = Cells(Cells.Rows.Count, "a").End(xlUp).Row
            Range("a" & RowCount + 1).Select
            ActiveSheet.Paste
            Sheets("2015 SHIPSHEET").Select
        End If
    Next
End Sub

但是现在不是在整个2015 SHIPSHEET上运行它，我更喜欢在选定的行上运行它。我尝试添加

Set Rng = Selection

但是没有用，它仍然在整张纸上运行。有关如何在选定行上运行此操作的任何建议吗？

当列为空时自动将行复制到单独的工作表中（以跟踪应收帐款）

2 个答案: