Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

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

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


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

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

skype: d_ober1
По умолчанию

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

Посмотрите здесь пример
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 вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

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


10:18.


Powered by vBulletin® Version 3.8.8 Beta 2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

RusProfile.ru


Справочник российских юридических лиц и организаций.
Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru