Определение терминов для поиска массива

Question

Я искал ответ на этот вопрос, но я не смог найти что-либо достаточно, чтобы заполнить пробел в знаниях VBA.

Я помещаю два списка данных в массивы для сравнения с использованием модифицированной версии кода here (я опубликую его ниже).

ОДНАКО, я не хочу вводить всю ячейку в массив для сравнения со вторым массивом. Например, если ячейка на первом листе говорит «Компания, LLC», я бы хотел только найти «Компанию». У меня есть некоторый код, который делает это:

s = rCell.Value 
    indexofthey = InStr(1, s, ",") 
    aftercomma = Right(s, Len(s) - indexofthey + 1) 
    celld = Left(s, Len(s) - Len(aftercomma)) 

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

Option Explicit 

Private Sub cmdCompare2to1_Click() 

Dim sheet1 As Worksheet, sheet2 As Worksheet, sheet3 As Worksheet 
Dim lngLastR As Long, lngCnt As Long 
Dim var1 As Variant, var2 As Variant, x 
Dim rng1 As Range, rng2 As Range 


Set sheet1 = Worksheets(1) 
Set sheet2 = Worksheets(2) 
Set sheet3 = Worksheets(3) ' assumes sheet3 is a blank sheet in your workbook 

Application.ScreenUpdating = False 

'let's get everything all set up 
'sheet3 column headers 
sheet3.Range("A1:B1").Value = Array("in1Not2", "in2Not1") 

'sheet1 range and fill array 
With sheet1 

    lngLastR = .Range("A" & .Rows.Count).End(xlUp).Row 

    Set rng1 = .Range("A1:A" & lngLastR) 
    var1 = rng1 

End With 

'sheet2 range and fill array 
With sheet2 

    lngLastR = .Range("A" & .Rows.Count).End(xlUp).Row 

    Set rng2 = .Range("A1:A" & lngLastR) 
    var2 = rng2 

End With 

'first check sheet1 against sheet2 
On Error GoTo NoMatch1 
For lngCnt = 1 To UBound(var1) 

    x = Application.WorksheetFunction.Match(var1(lngCnt, 1), rng2, False) 

Next 


'now check sheet2 against sheet1 
On Error GoTo NoMatch2 
For lngCnt = 1 To UBound(var2) 

    x = Application.WorksheetFunction.Match(var2(lngCnt, 1), rng1, False) 

Next 

On Error GoTo 0 
Application.ScreenUpdating = True 
Exit Sub 

NoMatch1: 
    sheet3.Range("A" & sheet3.Rows.Count).End(xlUp).Offset(1) = var1(lngCnt, 1) 
    Resume Next 


NoMatch2: 
    sheet3.Range("B" & sheet3.Rows.Count).End(xlUp).Offset(1) = var2(lngCnt, 1) 
    Resume Next 


End Sub 

Answer 1

Предполагая, что вы не хотите изменить значения в своих ячейках, вам нужно будет перебрать массивы. Вы можете использовать такую ​​процедуру:

Sub RemoveUnwantedText(ByRef theArray As Variant) 

Dim theValue As String 
Dim i As Long 
Dim indexOfComma As Integer 
    ' array is created from single-column range of cells 
    ' and so has 2 dimensions 
    For i = LBound(theArray, 1) To UBound(theArray, 1) 
     theValue = CStr(theArray(i, 1)) 
     indexOfComma = InStr(1, theValue, ",") 
     If indexOfComma > 0 Then 
      theValue = Trim(Left(theValue, indexOfComma - 1)) 
     End If 
     theArray(i, 1) = theValue 
    Next i 

End Sub 

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

RemoveUnwantedText var1 
RemoveUnwantedText var2