1

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

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

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

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

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

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

Ваш ответ

Нажимая «Отправить ответ», вы соглашаетесь с условиями пользования и подтверждаете, что прочитали политику конфиденциальности.

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