Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 07.09.2010, 22:00   #1
Andreog
Новичок
Джуниор
 
Регистрация: 07.09.2010
Сообщений: 1
Радость Как произвести поиск наиболее похожего материала

Проблемка ? Необходимо из перечня материалов в виде "отвод П45-89х4 сталь20 ГОСТ... и т.д." выбрать материал, наиболее похожий на заданный. Например на "отвод 45 - 89х4". Количество слов - до 15.
Andreog вне форума Ответить с цитированием
Старый 07.09.2010, 23:08   #2
doober
Старожил
 
Аватар для doober
 
Регистрация: 02.05.2009
Сообщений: 3,907
По умолчанию

Да проблемка.файл не выложили.

Посмотрите здесь пример
Simil -это функция сравнения строк
На выходе процент совпадения

для вашего случая Rez = Simil("отвод П45-89х4 сталь20 ГОСТ", "отвод 45 - 89х4")

Rez=62%
Код:
Private b1()
Private b2()

    Public Function Simil(ByVal String1 As String, ByVal String2 As String) As Double
        Dim l1 As Long
        Dim l2 As Long
        If UCase(String1) = UCase(String2) Then
            Simil = 1
        Else
            l1 = Len(String1)
            l2 = Len(String2)
            If l1 <> 0 And l2 <> 0 Then


ReDim b1(l1)
For m = 0 To l1 - 1

b1(m) = Asc(Mid(UCase(String1), m + 1, 1))

Next

ReDim b2(l2 - 1)
For m = 0 To l2 - 1

b2(m) = Asc(Mid(UCase(String2), m + 1, 1))

Next
          
                Simil = SubSim(1, l1, 1, l2) / (l1 + l2) * 2
            End If


        End If
        Erase b1
        Erase b2
    End Function

    Private Function SubSim(ByVal st1 As Long, ByVal end1 As Long, ByVal st2 As Long, ByVal end2 As Long) As Long
        Dim c1 As Long
        Dim c2 As Long
        Dim ns1 As Long
        Dim ns2 As Long
        Dim i As Long
        Dim max As Long
        If st1 > end1 Or st2 > end2 Or st1 <= 0 Or st2 <= 0 Then Exit Function
        For c1 = st1 To end1
            For c2 = st2 To end2
                i = 0
                Do Until b1(c1 + i - 1) <> b2(c2 + i - 1)
                    i = i + 1
                    If i > max Then
                        ns1 = c1
                        ns2 = c2
                        max = i
                    End If
                    If c1 + i > end1 Or c2 + i > end2 Then Exit Do
                Loop
            Next
        Next
        max = max + SubSim(ns1 + max, end1, ns2 + max, end2)
        max = max + SubSim(st1, ns1 - 1, st2, ns2 - 1)
        SubSim = max
    End Function
Анализ,обработка данных Недорого

Последний раз редактировалось doober; 08.09.2010 в 02:21.
doober вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Разбить текст на слова и произвести поиск каждого слова по текстовому массиву Burning_brook Microsoft Office Excel 2 22.05.2010 01:56
Как произвести простые вычисления ячеек в VB segail Microsoft Office Excel 18 13.12.2009 21:42
как произвести поиск в другой открытой книге? ShamanK Microsoft Office Excel 1 08.12.2009 05:30
Поиск похожего текста Valg Microsoft Office Excel 18 04.10.2009 20:32
Поиск похожего. Kukkk Общие вопросы Delphi 4 06.10.2007 23:11