重复查找以查找多个联系人电子邮件，并根据电子邮件的首字母匹配名字或姓氏

Question

公司列表，每行分别包含名称和电子邮件，将它们与其他公司列表匹配，以提取电子邮件和该个人的“猜测”名字。.姓氏，出于某种原因，姓氏在crm中被忽略。这个..

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