0

Я совсем недавно начал изучать VBA и у меня есть один вопрос.

Мне нужно сравнить две таблицы с именами на разных Excel вкладках. И если имя в одной таблице не совпадает с именем в другой - то ничего делать не надо.

Но если имена совпадают, то нужно создать третью вкладку которая бы содержала совпавшее имя. И так для всех совпавших имен. То есть, если будет 10 совпадений, то надо создать 10 вкладок, в каждой из которых будет совпавшее имя.

Буду очень благодарен за помощь с кодом!

3
  • Помощь - это когда Вы что-то делали, но появилась нерешаемая своими силами проблема. Покажите, что есть, над чем поработали 14 окт 2020 в 9:39
  • Я понимаю, но я действительно не знаю как можно это сделать, не используя огромное количество if в коде. И думал, что здесь мне подскажут.
    – Илья
    14 окт 2020 в 9:45
  • Читайте о циклах. Организовать цикл по листам книги: For Each sht As Worksheets. А помощь конкретнее - с Вашим примером 14 окт 2020 в 12:55

1 ответ 1

0

Добро пожаловать на StackOverflow, Илья!

На самом деле это не очень сложная задача. Её можно разбить на четыре простых фрагмента:

  1. перебрать ячейки диапазона по одной;
  2. отыскать значение ячейки в другом листе той же книги
  3. убедиться, что такой лист ещё не создан
  4. добавить лист в книгу

Собрать всё это вместе не намного труднее, чем сложить конструктор Лего:

Sub CreateSheetsForDoubles()
Dim aRange1 As Range, aRange2 As Range  ' Диапазоны ячеек с именами - первый и второй список
Dim oCell As Range                      ' Одна ячейка, чтобы перебрать каждую из ячеек в первом диапазоне
Dim sNextName As String                 ' Текст из ячейки oCell
Dim vResOfMatch As Variant              ' Результат поиска sNextName во втором списке - или номер строки, или ошибка
Dim sRes As String                      ' Текст финального сообщения - имена созданых листов
Dim ws As Worksheet                     ' Переменная для проверки "лист с таким именем уже существует?"
Dim sheet As Worksheet                  ' Переменная для новых листов
    Set aRange1 = [Лист1!A1:A10]        ' Диапазоны можно задать так...
    Set aRange2 = Worksheets("Лист2").Range("A1:A10")   ' ...или так. Или спросить в диалоге
    For Each oCell In aRange1           ' Для каждой ячейки в первом списке
        sNextName = Trim(oCell.Text)    ' Взять её текстовое представление без оконечных пробелов
        If sNextName <> vbNullString Then   ' Если текст в ячейке есть (если она не пустая)
        vResOfMatch = Application.Match(sNextName, aRange2, 0)  ' Попытаться отыскать это значение во втором списке
        If Not IsError(vResOfMatch) Then    ' Если не ошибка, значит во втором списке это имя есть
            Set ws = Nothing            ' Проверить, нет ли уже листа с таким именем (в случае, если макрос запускается повторно)
            On Error Resume Next
            Set ws = Worksheets(sNextName)
            On Error GoTo 0
            If ws Is Nothing Then       ' Нет, в єтой книге листа с таким именем нет
                If Len(sRes) > 0 Then sRes = sRes & ", "    ' Дополнить список найденных имён
                sRes = sRes & sNextName
Rem Создать лист, присвоить ему имя и вписать в первую ячейку то же самое имя
                Set sheet = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
                sheet.Name = sNextName
                sheet.[A1].Value = sNextName
            End If
        End If
        End If
    Next oCell
Rem В конце сообщить о результатах выполнения макроса
    If Len(sRes) = 0 Then
        Call MsgBox("Нет имен для новых листов")
    Else
        Call MsgBox("Созданы листы для " & sRes)
    End If
End Sub

Надеюсь, это поможет удачно стартовать в программировании. Успехов!

Ваш ответ

By clicking “Отправить ответ”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.