VBA - 移动大量记录 -​​ 缺少某些记录

Question

我的数据集大约有1500条销售记录。我编写了一个宏，它将创建特定于产品类别的工作簿，其中将为产品类别中的每个产品提供单独的工作表。

宏正在按预期工作，但我发现它一直忽略了某些产品。我根据产品代码过滤调试语句以查看是否获得零记录（因为我使用此选项将记录粘贴到单独的工作表中）。选择似乎正常，因为我得到了选择的行数。

我看到的模式是，没有记录的产品代码通常是在文件操作之前或之后进行处理的第一个或最后一个（我打开一个特定类别的工作簿，或者我正在关闭一个工作簿）。但即使在这里，表头也被复制到单个工作表中。只有数据行被忽略。

宏是否有可能过快地处理记录，而在执行文件I / O操作时会有一些时间滞后（这会使一些记录被忽略）？

我正在附加我用于循环的代码 ＆＃39;遍历每一行并获取产品ID和类别（Ann＆amp; Bnn）。

 '  Dim catWorkBook As Workbook
    oProductCat = "0" 'the initial value set as 0, which would NEVER be a category
    With wkScrap 'this is a rough sheet which has the product items and categories
        For i = 2 To lProdRow
            cProductCode = .Cells(i, 1).Value
            cProductCat = .Cells(i, 2).Value

            'FILE OPEN: will need to open a category specific .xls file
            If (StrComp(cProductCat, oProductCat) <> 0) Then
                'save the existing workbook
                FileIO.CloseExcelFile oProductCat, catWorkBook

                Set catWorkBook = Nothing 'clear all traces of the old worksheet
                Set catWorkBook = CreateBlankWorkBook()
                oProductCat = cProductCat
            End If

            'COPY DATA: Filtering on product code, and then moving it into a new
            'worksheet
            CopyCategoryToWorksheet cProductCode, catWorkBook

            If i = lProdRow Then
                'we are at the end of the loop. Proceed to close the current
                'workbook
                FileIO.CloseExcelFile oProductCat, catWorkBook
            End If
        Next
    End With

这是执行实际复制的功能

Private Sub CopyCategoryToWorksheet(prodCode As String, catWkBook As Workbook)
    'check for a meaningful prod code
    If (Trim(prodCode & vbNullString) = vbNullString) Then
        Exit Sub
    End If

    Dim wkRData As Worksheet
    Dim rRData As Range
    Dim rDataMaxRows As Integer
    Set wkRData = SalesReport.Sheet1

    'We know that we have to create a work sheet for this product code.
    'Let us do that first.
    Dim prodCatSheet As Worksheet
    catWkBook.Activate
    Set prodCatSheet = catWkBook.Sheets.Add(After:=catWkBook.Sheets(catWkBook.Sheets.Count))
    prodCatSheet.Name = prodCode

    wkRData.Activate 'for this sub routine, all processing is happening on the raw data sheet
    rDataMaxRows = Cells(rows.Count, 1).End(xlUp).Row
    Set rRData = Range("A1:H" & rDataMaxRows)
    rRData.AutoFilter 3, Criteria1:="=" & Trim(prodCode)
    rRData.Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy

    'activate the newly created sheet, and paste all the selected rows there
    prodCatSheet.Activate
    prodCatSheet.PasteSpecial

    Set wkRData = Nothing 'just clear some memory
End Sub