Сопоставление двух списков данных в Excel VBA и экспорт в новый лист

В приведенном выше коде есть несколько ошибок, и у меня также есть несколько предложений и, наконец, код.

ОШИБКИ

1) Sheets.Add.Name = "Output" Эта строка выдаст вам ошибку, если уже существует лист с названием "Вывод". Сначала удалите лист, а затем создайте его. Вам должно быть интересно, что если листа нет, то как я могу его удалить? Для таких сценариев вы можете использовать On Error Resume Next, чего следует избегать в большинстве случаев.

2) При работе с диапазонами всегда указывайте, на какой лист вы ссылаетесь, иначе Excel всегда будет считать, что вы имеете в виду «ActiveSheet». Поскольку вы поняли, что Sub Convert_to_Numbers() принимает во внимание Output лист, тогда как вы хотите, чтобы операция выполнялась на «выходном» листе.

3) Dim Full, Selection, Code, SelectedCode As Range Как упоминалось в моих комментариях ранее, избегайте использования зарезервированных слов Excel в качестве переменных. Кроме того, в отличие от VB.Net, если вы объявляете переменные, как в VBA, то только последняя переменная будет объявлена ​​как Range. Остальные 3 будут объявлены как варианты. VB по умолчанию присваивает переменной тип Variant. Переменная типа Variant может содержать данные любого типа: от строк до целых чисел, длинных целых чисел, дат, валюты и т. д. По умолчанию «варианты» являются «самым медленным» типом переменных. Также следует избегать вариантов, поскольку они несут ответственность за возможные «ошибки несоответствия типов». Дело не в том, что мы никогда не должны использовать варианты. Их следует использовать только в том случае, если вы не уверены, что они могут удерживать при выполнении кода.

4) Избегайте использования таких слов, как .ActiveCell, Selection, Select, Activate и т. д. Они являются основной причиной ошибок. Также они замедляют ваш код.

ПРЕДЛОЖЕНИЯ

1) Вместо того, чтобы каждый раз использовать Sheets("WhatEver"), сохраните его в переменной, а затем используйте эту переменную. Сократит ваш код.

2) Делайте отступы в коде :), так намного легче читать

3) Группируйте задачи вместе. Например, если вам нужно что-то сделать с определенным листом, держите его вместе. Его легче читать и вносить изменения, если это необходимо.

4) Вместо жесткого кодирования значений используйте фактические диапазоны. Range("A2:A2500") — классический пример. Всегда ли у вас будут данные до 2500? А если меньше или больше?

5) End(xlDown) никогда не даст вам последнюю строку, если между ними есть пустая ячейка. Чтобы получить последнюю строку в столбце, скажем A в "Лист1", используйте это

Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row`

6) Вместо зацикливания можно использовать WorksheetFunction CountIf(). Циклов следует избегать, насколько это возможно, поскольку они замедляют ваш код.

7) Используйте соответствующую обработку ошибок.

8) Прокомментируйте свой код. Гораздо проще узнать, что делает конкретный код или раздел.

КОД

Option Explicit

Sub Run_All_Macros()
    Dim ws1I As Worksheet, ws2I As Worksheet, wsO As Worksheet
    Dim ws1LRow As Long, ws2LRow As Long, wsOLr As Long
    Dim xCell As Range, rFull As Range, rSelection As Range
    Dim rCode As Range, rSelectedCode As Range

    On Error GoTo Whoa '<~~ Error Handling

    Application.ScreenUpdating = False

    '~~> Creating the Output Sheet
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("Output").Delete
    On Error GoTo 0
    Sheets.Add.Name = "Output"
    Application.DisplayAlerts = True

    '~~> Working with 1st Input Sheet
    Set ws1I = Sheets("Sheet1")
    With ws1I
        '~~> Get Last Row of Col A
        ws1LRow = .Range("A" & Rows.Count).End(xlUp).Row
        '~~> Set the range we want to work with
        Set rFull = .Range("A1:A" & ws1LRow)
        '~~> The following is not required unless you want to just format the sheet
        '~~> This will have no impact on the comparision. If you want you can
        '~~> uncomment it
        'For Each xCell In .Range("A2:A" & ws1LRow)
            'xCell.Value = CDec(xCell.Value)
        'Next xCell
    End With

    '~~> Working with 2nd Input Sheet
    Set ws2I = Sheets("Sheet2") '<~~ Input Sheet 2
    ws2LRow = ws2I.Range("A" & Rows.Count).End(xlUp).Row
    Set rSelection = ws2I.Range("A1:A" & ws2LRow)

    '~~> Working with Output Sheet
    Set wsO = Sheets("Output")
    wsO.Range("A1") = "Common values"
    wsOLr = wsO.Range("A" & Rows.Count).End(xlUp).Row + 1

    '~~> Comparison : If the numbers match copy them to Output Sheet
    For Each rCode In rFull
        If Application.WorksheetFunction.CountIf(rSelection, rCode.Value) > 0 Then
            rCode.Copy wsO.Range("A" & wsOLr)
            wsOLr = wsOLr + 1
        End If
    Next rCode

    MsgBox "Done"

LetsContinue:
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Дайте мне знать, если вы все еще получаете какие-либо ошибки :)

ХТН