VBA - 如何加快过滤过程

Question

现在我正在做一个数据量非常大的项目（700,000 行 * 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。宏转到原始数据表并按 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

Answer 1

这可以很快完成工作，但略有不同。它将查找并替换工作表中旧名称的每次出现，而不仅仅是 L 列。如果有其他列包含旧值并且您不希望替换这些值，我们可能必须试试别的。

这利用了 cybernetic.nomad 建议的内置查找和替换功能。它只扫描重映射表中的行，而不是目标工作表中的所有行。

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