Добрый день!
Часто в работе приходится прицеплять к списку названия фотографий.
Задумался о частичной автоматизации процесса и на этом сайте нашел великолепный скрит, который сравнивает содержимое ячеек в двух таблицах, вот этот:
spoiler for Hiden :
Option Explicit Option Compare Text '--------------------------------------------------------------------------------------- ' Procedure : CompareTxt ' DateTime : 10.03.2015 22:46 ' Author : The_Prist(Щербаков Дмитрий) ' WebMoney - R298726502453; Яндекс.Деньги - 41001332272872 ' http://www.excel-vba.ru ' Purpose : Сравнивает две строки по совпадению отдельных слов. Выводит процент, саму строку и номер строки ' s1 - исходный текст(ссылка на ячейку или текст) ' mass - диапазон значений для сравнения с исходным текстом(ссылка на ячейку или текст) ' sDelim - разделитель слов в тексте. По умолчанию пробел ' lFstLast - указатель, выводить первое или последнее подходящее совпадение. ' По умолчанию 0(последнее максимально совпадающее). ' Если указать 1 - будет выбрано первое подходящее(в котором совпадают все слова) ' lShowAllInfo - указатель на результат. Допускается четыре значения: ' -1 - показывается вся информация: Процент совпадения строк, Найденное значение, ' Номер строки в указанном диапазоне в которой найдено значение ' 1 - Выводится только процент совпадения строк ' 2 - выводится только значение ' 3 - выводится только номер строки с найденным значением ' По умолчанию применяется -1(вся информация) ' Синтаксис: ' =CompareTxt(A1;B1:B100) - с разделителем по умолчанию ' =CompareTxt(A1;B1:B100;"-") - с разделителем короткое тире(-) ' =CompareTxt(A1;B1:B100;"-";;2) - с разделителем короткое тире(-) и выводом только значения '--------------------------------------------------------------------------------------- Function CompareTxt(s1 As String, mass As Range, Optional sDelim As String = " ", Optional lFstLast As Long = 0, Optional lShowAllInfo As Long = -1) Dim as1, as2, l1 As Long, l2 As Long, lr As Long Dim asStr2 Dim s As String, s2 As String, lp, lTmpCom As Long, lResCom As Long Dim lResR As Long, sResS As String, v as1 = Split(s1, sDelim) asStr2 = mass.Value If Not IsArray(asStr2) Then ReDim asStr2(1 To 1, 1 To 1): asStr2(1, 1) = mass.Value For lr = 1 To UBound(asStr2, 1) as2 = Split(asStr2(lr, 1), sDelim) lResCom = 0 For l1 = LBound(as1) To UBound(as1) s = as1(l1) For l2 = LBound(as2) To UBound(as2) If as2(l2) = s Then lResCom = lResCom + 1 Exit For End If Next l2 Next l1 If lTmpCom < lResCom Then lTmpCom = lResCom lResR = lr sResS = asStr2(lr, 1) lp = lp + 1 End If If lFstLast Then If lTmpCom >= (UBound(as1) + 1) Then Exit For End If End If Next lr v = (lTmpCom / (UBound(as1) + 1)) * 100 Select Case lShowAllInfo Case -1 CompareTxt = "Процент совпадения: " & v & "; Значение: " & sResS & "; Строка в массиве mass: " & lResR Case 1 'только процент CompareTxt = v Case 2 'только значение строки CompareTxt = sResS Case 3 'только номер строки CompareTxt = lResR End Select End Function
Он меня устроил практически на 100%, но при обработке списка он подхватывает из таблицы с названиями фоток много лишнего.
Очень прошу помощи. Необходимо добавить в сравнение списков одно обязательное условие:
На первом скриншоте таблица с наименованиями товаров и штрих кодами, на втором - таблица с названиями файлов фотографий товара.
В названиях файлов в последние пару лет стали добавлять последние 4 цифры штрих кода всегда в конце названия файла, перед расширением. Бывает так, что у разных товаров эти последние цифры совпадают.
Помогите пожалуйста адаптировать скрипт под спойлером - нужно чтобы он брал из таблицы на рисунке 1 последние 4 цифры штрих кода, производил по ним поиск в таблице на рисунке 2 и потом уже проверял результаты на частичное совпадение с наименованием (рис1), а если не нашел совпадения по 4 цыфрам - выводил в ячейку надпись "нет фото".
Рис1.
Рис2.