1

我在excel中有一张如下表

1   apple   8/1/2013    8/2/2013    99373        11
2   apple   8/13/2013   8/3/2013    2626282    2121
3   berry   8/12/2013   8/4/2013    1289127     123
4   berry   8/15/2013   8/5/2013    12712671   1234
5   cherry  8/19/2013   8/6/2013    127127     3354
    apple   9/1/2013    9/5/2013    123456      200
    apple   9/2/2013    9/6/2013    246810      300
    berry   9/3/2013    9/7/2013    3691215     400
    berry   9/4/2013    9/8/2013    48121620    500
    cherry  9/5/2013    9/9/2013    510152025   600
    cherry  9/6/2013    9/10/2013   612182430   700
    apple   9/7/2013    9/11/2013   714212835   800
    berry   9/8/2013    9/12/2013   816243240   900
    berry   9/9/2013    9/13/2013   918273645   1000
    apple   9/10/2013   9/14/2013   10203040    1100

我正在尝试让 excel 复制上个月（在这种情况下 - 2013 年 9 月 1 日 - 2013 年 9 月 1 日 - 2013 年 9 月 30 日）写着苹果、浆果或樱桃的每一行，并将它们放在相应的工作表中。工作表名称是苹果、浆果和樱桃。然后它插入一行并将该行添加到最后一行数据之后的行。在将其复制到相应的工作表之前，我还需要它在 a 列中生成系列中的下一个数字。因此，第 6 行将在 a 列中有数字 6。

我已经尝试了一些 VBA 代码，但是我在动态搜索所有工作表名称而不仅仅是“苹果”时遇到了一些麻烦。我也很难找到最后一行的数据。请看下面我的代码：

Sub testIt()
Dim r As Long, endRow As Long, pasteRowIndex As Long

endRow = 15
pasteRowIndex = 1

For r = 1 To endRow

    If Cells(r, Columns("B").Column).Value = "apple" Then


        Rows(r).Select
        Selection.Copy


        Sheets("apple").Select
        Rows(pasteRowIndex).Select
        ActiveSheet.Paste


        pasteRowIndex = pasteRowIndex + 1



        Sheets("Sheet1").Select
    End If
Next r
End Sub
4

1 回答 1

1

我修改了您的代码，因此它不是逐个复制行，而是自动过滤，一次复制整个适用范围。此外，这假定任何未命名为“Sheet1”的工作表都将用作搜索和复制条件。

Application.CutCopyMode = False

Dim r As Long, c As Long
Dim ws As Worksheet
Dim sFruit As String
Dim wsRow as Long

Worksheets("Sheet1").Activate
r = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row 'find last row
c = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column 'find last column
Range("A1").AutoFilter
Range("C1:C" & r).AutoFilter Field:=3, Criteria2:=Array(1, "9/30/2013") 'filters for month of Sep'13

For Each ws In Worksheets
    If ws.Name <> "Sheet1" Then
        '*edited to accommodate pre-existing data
        ws.Activate '*activate sheet so you can use Cells() with it
        wsRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row + 1 '*find first usable row in ws
        sFruit = ws.Name 'criteria to look for
        Worksheets("Sheet1").Activate 'bring focus back to main sheet
        Range("B1:B" & r).AutoFilter Field:=2, Criteria1:=sFruit
        Range(Cells(2, 1), Cells(r, c)).SpecialCells(xlCellTypeVisible).Copy ws.Range("A" & wsRow)
    End If
Next ws

Range("A1").AutoFilter

Application.CutCopyMode = True

您可以添加按日期过滤的功能。我建议使用自动过滤器记录自己，以便您了解如何修改代码。

于 2013-10-05T16:15:56.900 回答