2014-11-06 2 views
4

My sub сравнивает два списка строк и возвращает самые близкие совпадения. Я обнаружил, что подсистема попадает под некоторые общие слова, такие как «the» и «facility». Я хотел бы написать функцию, которая будет снабжена массивом слов, чтобы исключить и проверить каждую строку для этих слов и исключить их, если они найдены.Функция VBA, чтобы исключить части строки

Вот входной образец:

|aNames  | bNames  | words to exclude 
|thehillcrest |oceanview health| the 
|oceanview, the|hillCrest  | health 

Предназначенный Выход:

|aResults  |bResuts 
|hillcrest |hillcrest 
|oceanview |oceanview 

До сих пор у меня есть:

Dim ub as Integer 
Dim excludeWords() As String 

'First grab the words to be excluded 
If sheet.Cells(2, 7).Value <> "" Then 
    For y = 2 To sheet.Range("G:G").End(xlDown).Row 
    ub = UBound(excludeWords) + 1    'I'm getting a subscript out of range error here..? 
    ReDim Preserve excludeWords(0 To ub) 
    excludeWords(ub) = sheet.Cells(y, 7).Value 
    Next y 
End If 

Тогда моя функция сравнения, используя двойную петлю, будет сравните каждую строку в столбце A со столбцом B. Перед сравнением значение в столбцах a и b будет проходить через наш f который будет проверять, чтобы эти слова были исключены. Вполне возможно, что не будет никаких слов, чтобы исключить, так что параметр должен быть дополнительно:

Public Function normalizeString(s As String, ParamArray a() As Variant) 
    if a(0) then   'How can I check? 
    for i = 0 to UBound(a) 
     s = Replace(s, a(i)) 
    next i 
    end if 
    normalizeString = Trim(LCase(s)) 
End Function 

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

Спасибо!

+0

Как выглядит «океан», «становится« океаном »? Вы можете заменить 'the', но это даст вам« океанское видение », а не« Oceanview ». Будет ли исключен список ваших слов, включая специальные символы? –

+0

Правильно, я должен отредактировать: дело здесь неважно (я вызываю LCASE на нем) – ZAR

+1

Я не говорю о случае здесь :) Я говорю о 'запятой'. См. Ответ, размещенный ниже. Возможно, вам придется обновить страницу –

ответ

6

Чтобы сохранить список в массиве, вы можете сделать это

Sub Sample() 
    Dim excludeWords As Variant 
    Dim lRow As Long 

    With Sheet1 '<~~ Change this to the relevant sheet 
     '~~> Get last row in Col G 
     lRow = .Range("G" & .Rows.Count).End(xlUp).Row 

     excludeWords = .Range("G2:G" & lRow).Value 

     'Debug.Print UBound(excludeWords) 

     'For i = LBound(excludeWords) To UBound(excludeWords) 
      'Debug.Print excludeWords(i, 1) 
     'Next i 
    End With 
End Sub 

А затем передать массив в вашей функции. Выше массив представляет собой 2D массив и, следовательно, должна быть обработана соответствующим образом (см комментировал раздел в приведенном выше коде)

Кроме того, как я уже говорил в комментариях выше

oceanview, the Как стать Oceanview? Вы можете заменить the, но это даст вам oceanview, (обратите внимание на запятую), а не Oceanview.

Возможно, вам придется передать эти специальные символы в Col G на листе, или вы можете обрабатывать их в своей функции с помощью цикла. Для этого вам придется использовать символы ASCII.Пожалуйста, см this

Followup от комментариев

Вот то, что я писал быстро, так что это не тщательно протестированы. Это то, что вы ищите?

Sub Sample() 
    Dim excludeWords As Variant 
    Dim lRow As Long 

    With Sheet1 
     lRow = .Range("G" & .Rows.Count).End(xlUp).Row 

     excludeWords = .Range("G2:G" & lRow).Value 

     '~~> My column G has the word "habilitation" and "this" 
     Debug.Print normalizeString("This is rehabilitation", excludeWords) 

     '~~> Output is "is rehabilitation" 
    End With 
End Sub 

Public Function normalizeString(s As String, a As Variant) As String 
    Dim i As Long, j As Long 
    Dim tmpAr As Variant 

    If InStr(1, s, " ") Then 
     tmpAr = Split(s, " ") 

     For i = LBound(a) To UBound(a) 
      For j = LBound(tmpAr) To UBound(tmpAr) 
       If LCase(Trim(tmpAr(j))) = LCase(Trim(a(i, 1))) Then tmpAr(j) = "" 
      Next j 
     Next i 
     s = Join(tmpAr, " ") 
    Else 
     For i = LBound(a) To UBound(a) 
      If LCase(Trim(s)) = LCase(Trim(a(i, 1))) Then 
       s = "" 
       Exit For 
      End If 
     Next i 
    End If 

    normalizeString = Trim(LCase(s)) 
End Function 
+0

Поскольку я использую алгоритм расстояния levenshtein, я не слишком беспокоюсь о таких мелочах, как запятые. Но целые слова, такие как «реабилитация», могут полностью испортить сравнение. – ZAR

+0

Также как выглядит функция normalizeString? Действительно ли это? – ZAR

+0

Да, это может быть проблемой в случае «ложного позитива». Я еще не проверял 'normalizeString' –

5

Прежде всего, вы не можете назвать UBound функции для массива, который не имеет размер еще:

Dim excludeWords() As String 

ub = UBound(excludeWords) + 1 'there is no size yet 

Для удаления некоторых нежелательных слов использовать Заменить функция

String1 = Replace(String1, "the", "") 

Чтобы сделать сравнение, которое вы описали, я бы использовал Как Функция. Вот документация. http://msdn.microsoft.com/pl-pl/library/swf8kaxw.aspx

+0

Спасибо за головы на UBound. Итак, какие у меня варианты? Я уже использую функцию replace. Наконец, я использую алгоритм расстояния levenshtein для вычисления подобия. Но этот раздел не обязательно включать в этот вопрос, я не думал. Спасибо @PolaEla – ZAR

+0

Да, вероятно, ваш способ сравнения лучше;). Так в чем же главный вопрос? – PolaEla