VBA - 如何加快过滤过程

VBA - How to speed up the filter process

现在正在做一个数据量非常大的项目(70万行*27列)。我现在面临的问题如下:

数据示例:

Date          Category1        P&L ........ (other columns)
20180901      XXCV             123,542
20180901      ASB              4523,542
20180901      XXCV             12243,544
20180901      XXCV             12334,542
20180901      DEE              14623,5441
.
.
.

现在我有一个新类别名称列表,我必须用新名称替换旧名称。该列表如下所示:

Old_name              New_Name
XXCV                  XASS
ASB                   CSS
.
.
.

我解决这个问题的方法是循环遍历列表中的所有旧名称,然后对原始数据中的每个名称进行过滤,最后将旧名称更改为新名称。

例如: 第一个循环是 XXCV。宏转到原始数据 sheet 并通过 XXCV 过滤列 "Catagory1"。然后将所有 XXCV 更改为 XASS。 宏 继续这样做,直到它循环遍历所有旧名称。

问题是!数据太多了!过滤过程很慢。

另外,我有2000个旧名字需要改成新名字。也就是说,我要循环2000次! 我花了很多时间才完成整个过程。

我知道在 Access 中执行此任务可能会更好。但是,是否有可能加快此过程并使其在 5-10 分钟内完成?

提前致谢!

编辑: 代码如下:

Sub Mapping_Table()

    Dim row_ori_book As Long
    Dim row_fin_book As Long
    Dim original_book As Variant

    Dim sheets_name As Variant
    Dim n_sheetName As Variant
    Dim row_end As Long
    Dim col_end As Long
    Dim row_loop As Long
    Dim n_ori_book As Variant

    ' Modify book name in sheet CoC_Exp_NExp & sheet CoC UU
        Sheets("Mapping_Table").Activate
        row_ori_book = Cells(Rows.Count, "A").End(xlUp).Row
        'row_fin_book = Cells(Rows.Count, "B").End(xlUp).Row
        original_book = Range(Cells(2, "A"), Cells(row_ori_book, "A")).Value
        sheets_name = Array("CoC_Exp_NExp", "CoC_UU")

        For Each n_sheetName In sheets_name
            Sheets(n_sheetName).Activate
            row_end = Cells(Rows.Count, "A").End(xlUp).Row
            col_end = Cells(1, Columns.Count).End(xlToLeft).Column
            row_loop = 2

            For Each n_ori_book In original_book
                ActiveSheet.AutoFilterMode = False

                Range(Cells(1, 1), Cells(row_end, col_end)).AutoFilter Field:=12, Criteria1:=n_ori_book, Operator:=xlFilterValues
                On Error Resume Next
                Range(Cells(2, "L"), Cells(row_end, "L")).SpecialCells(xlCellTypeVisible).Value = Sheets("Mapping_Table").Cells(row_loop, "B").Value
                On Error GoTo 0
                row_loop = row_loop + 1
                ActiveSheet.AutoFilterMode = False
            Next n_ori_book
        Next




    End Sub

这样做速度很快,但略有不同。它将查找并替换 每个 在 sheet 中出现的旧名称,而不仅仅是列 L。如果有其他列包含旧值并且您不想要那些被替换的,我们可能不得不尝试别的东西。

这利用了 cybernetic.nomad 建议的内置查找和替换功能。它仅扫描重新映射 table 中的行而不是目标 sheets.

中的所有行
Sub Mapping_Table()

    Dim mapTable As Range   ' Column A (old name) maps to Column B (new name)
    Dim mapRow As Integer   ' Index for walking through map table

    Dim sheetNames As Variant  ' Array of sheet names to update
    Dim sheetName As Variant   ' Sheet name being processed

    ' Get the map table
    Set mapTable = Sheets("Mapping_Table").UsedRange

    ' Set the list of sheets to process
    sheetNames = Array("CoC_Exp_NExp", "CoC_UU")

    ' Search and replace
    For Each sheetName In sheetNames
        For mapRow = 1 To mapTable.Rows.Count
            Sheets(sheetName).Cells.Replace What:=mapTable.Cells(mapRow, 1).Text, _
                                            Replacement:=mapTable.Cells(mapRow, 2).Text, _
                                            LookAt:=xlWhole, _
                                            SearchOrder:=xlByRows, _
                                            MatchCase:=False, _
                                            SearchFormat:=False, _
                                            ReplaceFormat:=False
        Next
    Next

End Sub