Повторный поиск, чтобы найти несколько контактных писем и сопоставить имя или фамилию с первой буквы письма

Question

Список компаний 1 строка, каждая из которых содержит имя и адрес электронной почты, сопоставьте их со списком других компаний, запрашивающих адрес электронной почты и «угаданное» имя этого лица.this ..

VLookup позволяет мне получить только 1, а индекс и сопоставление не полностью соответствуют моим потребностям, поэтому я пришел к следующему коду.

Оба списка в алфавитном порядкепорядок, поэтому я должен быть в состоянии поддерживать полностью прямой поток, но я не был уверен, как его реализовать, любые мысли или указатели были бы хорошими.

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

Function Col_Letter(lngCol As Long) As String
    Dim vAretureturnNameRow
    vAretureturnNameRow = Split(Cells(1, lngCol).Address(True, False), "$")
    Col_Letter = vAretureturnNameRow(0)
End Function
Sub exec()

Dim Found As Boolean
Found = False

'result Row Column
Dim returnNameRow As Long, returnNameColumn As Long

returnNameRow = 2
returnNameColumn = 2

'result Sheet Name
Dim returnName As String

returnName = "Sheet3"

'Deals Value Row and Column
Dim DataValueRow As Integer

DataValueRow = 2


'Lookup Name
Dim LookupName As String

LookupName = "Sheet1"

'Lookup Column
Dim CurrentLookupRow As Long, SignifigantValueColumn1 As Long, SignifigantValueColumn2 As Long, SignifigantValueColumn3 As Long

CurrentLookupRow = 3

SignifigantValueColumn1 = 4

SignifigantValueColumn2 = 2

SignifigantValueColumn3 = 3

Do
    'Select RetureturnName Sheet
    Sheet3.Select

    'Get Value from RetureturnName Sheet
    Lookup = Range("A" + CStr(DataValueRow)).Value

    'Select Lookup Sheet
    Sheet1.Select
    CurrentLookupRow = 3
    'if Lookup equals the value in lookup sheet
    Do
        test = Range("A" + CStr(CurrentLookupRow)).Value
        If (Lookup = test) Then
            Found = True

            'pull value from Value Column
            If (IsEmpty(Range(Col_Letter(SignifigantValueColumn1) + CStr(CurrentLookupRow)).Value) = False) Then

                EmailFirstLetter = LCase(Left(Range(Col_Letter(SignifigantValueColumn1) + CStr(CurrentLookupRow)).Value, 1))

                Value1 = Range(Col_Letter(SignifigantValueColumn1) + CStr(CurrentLookupRow)).Value

                If (EmailFirstLetter = LCase(Left(Range(Col_Letter(SignifigantValueColumn2) + CStr(CurrentLookupRow)).Value, 1))) Then
                    Value2 = Range(Col_Letter(SignifigantValueColumn2) + CStr(CurrentLookupRow)).Value
                Else
                    Value2 = Range(Col_Letter(SignifigantValueColumn3) + CStr(CurrentLookupRow)).Value
                End If
                'select the retureturnName Sheet
                Sheet3.Select

                'insert value into Column
                Range(Col_Letter(returnNameRow) + CStr(returnNameColumn)).Value = Value1
                returnNameRow = returnNameRow + 1
                Range(Col_Letter(returnNameRow) + CStr(returnNameColumn)).Value = Value2
                returnNameRow = returnNameRow + 1
                'increment retureturnName Column


                    Sheet1.Select



            End If

        End If
        CurrentLookupRow = CurrentLookupRow + 1

    Loop Until (CurrentLookupRow > 21920)

    returnNameColumn = returnNameColumn + 1

    returnNameRow = 2

    DataValueRow = DataValueRow + 1

Loop Until (DataValueRow > 190)

End Sub