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

VBA-如何加快筛选过程

1 个答案: