----------编辑：----------

Question

请注意原始功能代码块之后的编辑

我已经在Excel中获得了这个数据集，我每个月从我公司的成本管理系统下载。平均而言，此数据集大约为100,000行，包含32列。我的工作职能之一是过滤掉不属于我的工作组的订单项，并按照所需格式为单独的分析系统排列数据。通常，我重新排列列，在单元格中输入一组公式，然后使用一系列自动过滤检查来识别需要移动到其他工作表的行项目。这通常需要我几个小时的时间，但它非常艰巨，我宁愿自动化这个过程，以节省时间，减少我犯错误的机会。

所以我继续编写了一个满足所有要求的VBA程序，一切似乎都在检查。唯一的问题是程序本身需要大约一个小时来检查10,000个订单项（我在那时停止了它）。浪费10个小时观看进度条，不会削减它。所以现在我试着重新思考我是如何编写这个程序的，看看是否有更好的方法（我确定有）。

这里是代码的原样（为了清楚起见，我在主循环之前和之后省略了很多代码，但是我在那里留下了注释，这样你就可以看到在＆＃39;伪代码中发生了什么＆＃ 39;方式。绝大部分时间都花在了那个循环上，所以它确实是我的主要关注点）：

原始功能

Function Prepare_CICTDF()
'Rename and set worksheet
    wbRawFile.Worksheets("Sheet1").Name = "Excluded"
    Set wsSheet = wbRawFile.Worksheets("Excluded")
'Update progress bar
    status_message = "Rearranging columns in CICT Dedicated Facility.  This may take several minutes."
    Call Progress_Bar(current_row, status_message)
'Rearrange columns
    'Omitted to shorten code block
'Create worksheet for included rows
    wbRawFile.Worksheets.Add().Name = "Self Service"
'Copy header row to other worksheets
    wsSheet.Rows("4").Copy Destination:=Sheets("Self Service").Range("A4")
'Import Lookup List
    Dim wbLookupList As Workbook
    Set wbLookupList = Workbooks.Open("\\server\path\to\file\Dedicated Facility Lookup List.xlsx")
    Dim wsLookupList As Worksheet
    Set wsLookupList = wbLookupList.Worksheets("Lookup List")
    wsLookupList.Copy Before:=wbRawFile.Worksheets("Excluded")
    wbLookupList.Close SaveChanges:=False
'Get first and last data row
    Dim FirstRow As Long
    Dim LastRow As Long
    FirstRow = 5
    LastRow = wsSheet.UsedRange.Rows.Count - 1
'Update progress bar
    status_message = "Preparing rows in CICT Dedicated Facilty."
    Call Progress_Bar(current_row, status_message)
'Loop through the rows to add formulas
    Dim NextBlankRow As Long
    Dim RowDeleted As Boolean
    Dim i As Long
        i = FirstRow

    '-------------------------LOOP STARTS HERE-------------------------
    Do While i <= LastRow
        RowDeleted = False
        'Add "CICTDF" before project ID
            wsSheet.Range("B" & i).Value = "CICTDF" & wsSheet.Range("B" & i).Text
        'Add formula for "Total Impact" column in column T
            wsSheet.Range("T" & i).FormulaR1C1 = "=IF(AND(RC[-10]=""Complete"",RC[7]=""Manual Part Number Line Item""),RC[5],IF(AND(RC[-10]=""Complete"",RC[5]=0),0,IF(RC[-10]=""Complete"",RC[5]/RC[-5]*RC[4],RC[5])))"
        'Add formula for rows with blank "Cost Impact - Part" column
            If wsSheet.Range("V" & i).Value = "" Then
                wsSheet.Range("V" & i).FormulaR1C1 = "=IF(RC[-7]>0,RC[3]/RC[-7]*-1,0)"
            End If
        'Change GLOBAL SUPPLY NETWORK to GLOBAL PURCHASING
            If wsSheet.Range("F" & i).Value = "GLOBAL SUPPLY NETWORK" Then
                wsSheet.Range("F" & i).Value = "GLOBAL PURCHASING"
            End If
        'Change numbers stored as text back to numbers
            wsSheet.Range("M" & i).NumberFormat = "General"
            wsSheet.Range("M" & i).Value = wsSheet.Range("M" & i).Value
            wsSheet.Range("P" & i).NumberFormat = "General"
            wsSheet.Range("P" & i).Value = wsSheet.Range("P" & i).Value
            wsSheet.Range("AB" & i).NumberFormat = "General"
            wsSheet.Range("AC" & i).NumberFormat = "General"
            wsSheet.Range("AD" & i).NumberFormat = "General"
            wsSheet.Range("AE" & i).NumberFormat = "General"
        'Insert Cab Part # Formula
            wsSheet.Range("AB" & i).Formula = "=VLOOKUP(M" & i & ",'Lookup List'!A:A,1,FALSE)"
        'Insert Cabs DC formula
            wsSheet.Range("AC" & i).Formula = "=VLOOKUP(N" & i & ",'Lookup List'!B:B,1,FALSE)"
        'Insert Cab Localization HEX & MG Formula
            wsSheet.Range("AD" & i).Formula = "=VLOOKUP(B" & i & ",'Lookup List'!C:C,1,FALSE)"
        'Insert Already in MOASS formula
            wsSheet.Range("AE" & i).Formula = "=VLOOKUP(B" & i & ",'Lookup List'!D:D,1,FALSE)"
        'Include part numbers that match the inclusion criteria
            If wsSheet.Range("AB" & i).Text <> "#N/A" And wsSheet.Range("AC" & i).Text = "#N/A" And wsSheet.Range("AD" & i).Text = "#N/A" _
            And wsSheet.Range("AE" & i).Text = "#N/A" And wsSheet.Range("P" & i).Value = "14" Then
                NextBlankRow = Worksheets("Self Service").UsedRange.Rows.Count + 1
                    wsSheet.Rows(i).Copy Destination:=Worksheets("Self Service").Range("A" & NextBlankRow)
                    wsSheet.Rows(i).Delete
                RowDeleted = True
            End If
        'Check if the row was included or not
            If RowDeleted = True Then
                LastRow = LastRow - 1
            Else
                i = i + 1
            End If
        'Update the progress completion
            current_row = current_row + 1
            Call Progress_Bar(current_row, status_message)
    Loop
    '-------------------------LOOP STOPS HERE-------------------------

'Autofilter header row in Self Service tab
    Worksheets("Self Service").Range("B4:AG4").AutoFilter
'Save as new file format
    Worksheets("Self Service").Select
    wbRawFile.SaveAs Filename:=output_directory & "CICT 2014 Dedicated Facility.xlsx", FileFormat:=51
    wbRawFile.Application.DisplayAlerts = True
    wbRawFile.Close SaveChanges:=False
End Function

基本上我遍历文件中的所有行。对于每一行，我输入我需要的公式和值，然后检查它们是否满足包含要求。如果他们这样做，我会把线移到＆＃34;自助服务＆＃34;工作表，删除＆＃34;排除＆＃34;工作表，然后转到下一行。

运行前10,000行数据后，经过的时间刚刚超过58分钟。我认为大部分原因可归结为循环尾端的复制/粘贴/删除过程。我已经读过一个常见的建议是在数组中工作，而不是在Excel中操作单元格/行/范围，但我不确定如何进行此操作。

----------编辑：----------

在Ron Rosenfeld的一些意见之后，我重新审视了我的过程并做了一些改变。最后，新程序在49分钟内处理并准备了超过100,000行（32列）。原始程序将花费9.75小时，因此更改导致程序比其前任程序快10倍。我不会再次粘贴整个代码块，而是在＆＃34;伪代码＆＃34;中描述过程：

重新排列列（获取原始服务器下载并按照我需要的顺序放置）。
为包含的行创建新工作表。请注意，出于我的目的，我处理了超过100,000行，但最终只保留了大约10,000行。因此，我决定寻找那些我会包含的东西而不是那些我会排除的东西。
在第一行数据中输入公式并向下拖动列。我使用了Ron的建议，例如Range("A" & FirstRow & ":A" & LastRow") = "=B1+C1"我可以使用任何列。
如果单元格为空白，则只有一列只需要公式。所以我使用SpecialCells(xlCellTypeBlanks)方法输入这些。
自动过滤数据，以便只显示我想要包含的行。我再次使用SpecialCells(xlCellTypeVisible)方法查找这些并将它们存储在一个数组中。然后将此数组输入新工作表。
最后，我做了一些格式化按摩，以确保一切看起来一致（因为存储数组中的值会丢失单元格格式。）

还应该注意的是，我认为蒂姆关于在这种情况下使用SQL的建议可能是一个非常有效的选择 - 我根本不熟悉这个主题来尝试它。不过，我会在寻找将来使用它的方法！

感谢大家的帮助！

Answer 1

在不知道工作表的确切布局的情况下，很难说。通常，关于值，将大DB读入数组的过程;循环遍历数组以决定要保留哪些行/项，回写到新工作表的写入通常比循环遍历行至少快一个数量级（10x）。有时候挑战是要弄清楚结果数组需要多大。如果用一些简单的公式无法做到这一点，我采取了临时步骤，在对结果数组进行尺寸标注之前将每一行收集到一个集合中。

查看代码后的另一个想法：为什么不过滤第15,27-30列的值，然后将可见单元格复制/粘贴到新工作表中。

将数据写入工作表后;您可以使用SpecialCells方法选择范围内的所有空白，并按以下方式编写公式：

R.columns(X).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "= RC[1] + RC[2]".

要获得arrIncluded的大小，似乎你可以使用CountIfs;或者您可以将所需的行添加到Collection，然后使用Count属性来获取arrIncluded的大小;并将Collection写入数组。我更喜欢Collection方法，但测试看哪种方式更快。</ p>

Excel VBA：从工作表中删除行的更有效方法

原始功能

----------编辑：----------

1 个答案: