Trogers96 Ответов: 2

Excel VBA vlookup с несколькими результатами

I have a list of reports in Column A that go to a list of emails in Column B. Column B has anywhere between 1 email and 10 separated by a comma ",". I need a Vlookup or VBA code to help me sort the list in a new sheet as Column A being each individual email (already done) and then the report(s) each email receives in Column B. The problem I run into is that there is roughly 250 reports, some with the same name and roughly 125 emails in Column B but mainly of the emails repeating in different rows. I need it as Column A: Emails Column C: Reports so that I can start to see what email is getting what report so I can start trimming reports/merging similar, etc. Column B is taken by another VBA function verifying that emails still exist in the domain contact group. How can I achieve this list of emails getting reports?
Текущие имена листов-это исходные данные: "ReportsQuery" и то, куда я помещаю данные: "электронные письма".

Пример листа excel:

Report Title | Emails
Report One | Emailone@email.com,Emailtwo@email.com
Report Two | Emailone@email.com,Emailthree@email.com,emailfour@email.com
Report Three | Emailfive@email.com,Emailone@email.com,emailsix@email.com
Report Four  | Emailseven@email.com


Что я уже пробовал:

Я попробовал просто Формулы Vlookup, но он будет сообщать об одном отчете, а не о нескольких. Также пробовать 
=INDEX(ReportValues!$A$2:$Q$1000,QUOTIENT(ROW(A2)-2,16)+1,MOD(ROW(A2)-2,16)+1)
что также дает мне один отчет.

Пытался: 
=IFERROR(INDEX(return_range, SMALL(IF(lookup_value = lookup_range, ROW(return_range) - m, ""), COLUMN() - n)), "")

СО ЗНАЧЕНИЯМИ: 
=IFERROR(INDEX(ReportQuery!$A$2:$A$1000, SMALL(IF($A2 = ReportQuery!$B$2:$B$1000, ROW(ReportQuery!$A$2:$A$1000) - 1, ""), COLUMN() - 3)), "")

но он возвращает пустой из-за того, что значение lookup email имеет больше, чем просто одно электронное письмо.

Maciej Los

Пожалуйста, поделитесь образцами данных...

Trogers96

Название Доклада | Сообщения
Доклад Один | Emailone@email.com,Emailtwo@email.com
Доклад второй | Emailone@email.com,Emailthree@email.com,emailfour@email.com
Доклад третий | Emailfive@email.com,Emailone@email.com,emailsix@email.com
Доклад Четвертый | Emailseven@email.com

Сработает ли это?

Patrice T

Воспользуйся Улучшить вопрос чтобы обновить ваш вопрос.
Чтобы каждый мог обратить внимание на эту информацию.

2 Ответов

Рейтинг:
2

Patrice T

Цитата:
Excel VBA vlookup с несколькими результатами

VLookup с "множественными результатами" не существует. Я думаю, что вам нужно создать соответствующую программу VBA.
Насколько я понимаю, чего вы хотите, у вас есть список:
Report Title | Emails
Report One | Emailone@email.com,Emailtwo@email.com
Report Two | Emailone@email.com,Emailthree@email.com,emailfour@email.com
Report Three | Emailfive@email.com,Emailone@email.com,emailsix@email.com
Report Four | Emailseven@email.com

и хотите, так или иначе, преобразовать его в:
Report Title | Email
Report One | Emailone@email.com
Report One | Emailtwo@email.com
Report Two | Emailone@email.com
Report Two | Emailthree@email.com
Report Two | emailfour@email.com
Report Three | Emailfive@email.com
Report Three | Emailone@email.com
Report Three | emailsix@email.com
Report Four | Emailseven@email.com

а затем отправляйте отчеты из этого израсходованного списка.

Насколько я знаю XL, нет никакой стандартной функциональности, чтобы сделать это преобразование, вам нужно сделать такую программу, как:
' get number of rows
' loop on each row
  ' split emails with RegEx
  ' loop on email list
    ' write the new couple report/email

Maciej Los

5ed!

Patrice T

Спасибо

Рейтинг:
11

Maciej Los

Попробовать это:

Option Explicit

Sub SplitEmails()
    Dim srcWsh As Worksheet, dstWsh As Worksheet
    Dim i As Long, j As Long, k As Long
    Dim emails() As String

On Error GoTo Err_SplitEmails

    Set srcWsh = ThisWorkbook.Worksheets(1) 'replace 1 with corresponding sheet name, for ex.: ThisWorkbook.Worksheets("ReportQuery")
    Set dstWsh = ThisWorkbook.Worksheets(2) 'replace 2 with corresponding sheet name, for ex.: ThisWorkbook.Worksheets("FinalData")

    With dstWsh
        .Range("A1") = "Report"
        .Range("B1") = "Email"
        .Range("A1:B1").Font.Bold = True
        .Range("A1:B1").Interior.Color = vbGreen
        .Range("A1:B1").Borders.LineStyle = xlContinuous
    End With

    i = 2
    k = 2
       
    Do While srcWsh.Range("A" & i) <> ""
        emails = Split(CStr(srcWsh.Range("B" & i)), ",")
        For j = LBound(emails()) To UBound(emails())
            With dstWsh
                .Range("A" & k + j) = srcWsh.Range("A" & i)
                .Range("B" & k + j) = Trim(emails(j))
                .Range("A" & k + j & ":B" & k + j).Borders.LineStyle = xlContinuous
            End With
        Next
        k = k + j
        i = i + 1
    Loop


Exit_SplitEmails:
    On Error Resume Next
    Set srcWsh = Nothing
    Set dstWsh = Nothing
    
    Exit Sub

Err_SplitEmails:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_SplitEmails

End Sub


Как им пользоваться?
1. Откройте файл, содержащий данные
2. Нажмите кнопку CTR+F11 чтобы переключиться на панель кода Visual Basic for Applications и открыть ее
3. Перейти к Insert меню и нажмите кнопку Module
4. Скопировать макрос и вставить его в новый модуль
5. переместите курсор в SplitEmails и щелкните там, где внутри тела этой процедуры, а затем запустите ее (F5).

Это все. Удачи вам!

Trogers96

Я отмечаю это как решение. Одна небольшая проблема , с которой я сталкиваюсь, заключается в том, что он делает пустые строки в конце писем для отчетов, потому что в моих данных у меня есть и после последнего письма. Во всяком случае, чтобы обойти это в целях эффективности? Спасибо!

Maciej Los

Отлично!
Да, есть способ избежать пустых строк. 

...
k = k + j
If Trim(dstWsh.Range("B" & k-1))="" Then k = k - 1 'here!
i = i + 1
...