VBA - Как ускорить процесс фильтрации - PullRequest
Новая
       12

VBA - Как ускорить процесс фильтрации

0 голосов
/ 01 ноября 2018

Сейчас я делаю проект с очень большими данными (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. Макрос перейти к исходному паспорту и отфильтровать столбец "Catagory1" по XXCV Затем поменяйте все XXCV на XASS. Макрос Продолжайте делать это до тех пор, пока не закроете все старое Имя.

Проблема в том, что данных слишком много! Процесс фильтрации очень медленный.

Более того, у меня есть 2000 старых имен, которые нужно поменять на новые. Другими словами, я должен зацикливаться 2000 раз! Мне потребовалось так много времени, чтобы закончить весь процесс.

Я знаю, что выполнение этой задачи в Access могло бы быть лучше. Однако можно ли ускорить этот процесс и завершить его за 5-10 минут?

Заранее спасибо!

Edit: Коды следующие: 

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

1 Ответ

0 голосов
/ 01 ноября 2018

Это делает работу очень быстро, но немного по-другому. Он найдет и заменит каждый вхождения старого имени на листе, а не только столбец 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
...