С наступающим Новым годом! Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.55/20: Рейтинг темы: голосов - 20, средняя оценка - 4.55
PredatorUA
0 / 0 / 0
Регистрация: 04.12.2012
Сообщений: 5
1

Поиск значений по частичному совпадению

04.12.2012, 14:04. Просмотров 3764. Ответов 11
Метки нет (Все метки)

Добрый день. Заранее благодарю за помощь.
Имеется файл, в котором на "листе1" в столбце "А" находятся артикулы изделий, а в столбце "В" их описание. На "листе2" в стобце "В" находится только описание. Задача: для каждого описания (столбец "В") из "листа2" найти артикул на "листе1" и вставить его значение в стобец "А" "листа2". При этом необходимо учесть, что значения из стобца "В" "листа2" могут иметь лишние символы (пробелы, тире, точки, запятые, вообщем ошибки связанные со "случайными лишними" символами). Другими словами "Т20.00.017 Зацеп" должно соответствовать "Т20 . 00.017 Зацеп" или "Т -20.00.017 Зацеп" или "Т20.00,017- Зацеп". Возможно ли это вообще?
0
Вложения
Тип файла: rar Поиск по описанию.rar (14.1 Кб, 39 просмотров)
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
04.12.2012, 14:04
Ответы с готовыми решениями:

Поиск файлов по частичному названию + Application.InputBox ?
Уважаемые Форумчане ,подскажите пожалуйста .Как к этой строке кода прикрутить...

Поиск по совпадению в VBA_EXCEL
Как организовать в Excel поиск по совпадению, как стандартном поиске Excel, а...

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

Макрос для фильтра строк по совпадению номера в коде и таблице
Доброго времени суток! Возник такой вопрос, пытаюсь отфильтровать большую...

Поиск значений
Помогите пожалуйста с решением данной задачи. В столбце A, начиная с ячейки...

11
Скрипт
5446 / 1127 / 49
Регистрация: 15.09.2012
Сообщений: 3,420
04.12.2012, 14:35 2
PredatorUA, мне такая идея пришла: перед сравнением данных из ячейки второго листа с ячейкой с первого листа, удалять из ячеек такие символы: точка, запятая, дефис, слеш, пробелы. Удалить это всё - затем сравнить. Имеется ввиду удалять не фактически, а средствами языка программирования VBA.


Или второй вариант у меня: использоать полуавтоматическое решение вашей задачи. Т.е. будет искаться какое-то наименование и всевозможные варианты этого наименования будут собраны в список. А пользователю нужно будет выбрать нужное наименование из этого списка.
1
Igor_Tr
4369 / 653 / 36
Регистрация: 17.01.2010
Сообщений: 2,134
04.12.2012, 15:39 3
Функция очистки. Не моя, но рабочая и помогает

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Public Function ОчисткаСпецСимволов( _
        ByVal strSearchIn As String, _
        Optional ByVal blnTrim As Boolean = False, _
        Optional ByVal blnSpaseDelete As Boolean = False, _
        Optional ByVal blnSymbolAnd As Boolean = False) As String  ' _
                      
    Dim i As Integer
    Dim strNew As String        ' 
    Dim siAsc As Integer        ' 
    Dim siMid As String * 1     ' 
    Dim siLen As Integer        ' 
    
    strNew = strSearchIn    ' 
    
    If blnSpaseDelete = True Then ' 
        strNew = Replace(strNew, " ", "")
    End If
 
    siLen = Len(strNew)     '
    For i = 1 To siLen      ' 
        siMid = Mid(strSearchIn, i, 1)  ' 
        siAsc = Asc(siMid)  ' 
        If siAsc < 32 Then strNew = Replace(strNew, siMid, "")  ' _
                                удаление, в т. ч., Chr(9), Chr(10), Chr(13) и т.д.
    Next i
   
    If blnTrim = True Then strNew = Trim(strNew) ' 
    If blnSymbolAnd = True Then _
        strNew = Replace(strNew, "&", "") ' удаляем _
                                                                                символ "&")
    ОчисткаСпецСимволов= strNew             ' возврат
    
End Function
Sub Test_func()
    dim mstr$
        mstr = ОчисткаСпецСимволов(mstr, _
                                                True, True, True)
End Sub
Добавлено через 13 минут
Мне "спасибо" не за что. Не я писал.
1
PredatorUA
0 / 0 / 0
Регистрация: 04.12.2012
Сообщений: 5
04.12.2012, 18:38  [ТС] 4
Спасибо за помощь, но оказалось я слаб в VBA. Помогите написать макрос на моем примере.
В "листе2" необходимо заполнить столбец "А" на основании данных из столбца "В". Т.е. нужно поместить в буфер значение ячейки "В1", найти такое же значение в столбце "В" "листа1", скопировать в буфер значение ячейки "А" и вставить это значение в ячейку "А1" "листа2". При поиске желательно учесть следующее:
1) У нас 100% совпадение и нет повторяющихся значений (я выложил часть файла, в оригинале в столбце "В" "листа1" может быть несколько идентичных значений) - заполняем ячайку "А1" "листа2"
2) Совпадений нет, тогда выполнить поиск с удалением "паразитных" символов. При условии нахождения единственного совпадения заполнить ячейку "А1" "листа2"
3) Совпадений нет и при поиске с удалением "паразитных" символов находится несколько значений. Предоставить возможность выбрать самостоятельно из найденных значений, возможно в виде открывающегося списка.
4) Совпадений нет. Оставить ячейку "А1" "листа2" пустой.
Заполнить столбец "А" "листа2" необходимо для всех не пустых ячеек стобца "В" "листа2".

Надеюсь понятно описал...Заранее благодарен.
0
Скрипт
5446 / 1127 / 49
Регистрация: 15.09.2012
Сообщений: 3,420
04.12.2012, 18:44 5
PredatorUA, а если 100% совпадение и есть повторяющиеся значения?
1
Igor_Tr
4369 / 653 / 36
Регистрация: 17.01.2010
Сообщений: 2,134
04.12.2012, 19:04 6
Я предлагаю Вам следующее:
У Вас два выражения. Оба зачищаете (это только в VBA, значения ячеек не изм-ся). Сравниваете оба выражения по двум критериям: 1.по длинне a=Len(str1), b=Len(str,2); 2. По значению (как Вам лучьше - Like, inStr, StrComp....). Результат СНАЧАЛА! осмысливаете, потом все дальше переводите на VBA. Я думаю, все будет в циклах, поэтому бояться вывыха пальцев не стоит, так-как листинг будет "далек по длинне от формул аэродинамики".
0
PredatorUA
0 / 0 / 0
Регистрация: 04.12.2012
Сообщений: 5
05.12.2012, 09:57  [ТС] 7
Цитата Сообщение от Скрипт Посмотреть сообщение
PredatorUA, а если 100% совпадение и есть повторяющиеся значения?
Аналогично 3 пункту. Спасибо, что напомнили об этом варианте.
0
Скрипт
5446 / 1127 / 49
Регистрация: 15.09.2012
Сообщений: 3,420
05.12.2012, 11:24 8
PredatorUA, большое задание очень получается.
Придётся вам самим его делать и уже задавать по этому заданию конкретные вопросы.
Потому что на написание кода уйдёт несколько часов.

Хотя может кто и напишет весь код, у кого время есть.
0
PredatorUA
0 / 0 / 0
Регистрация: 04.12.2012
Сообщений: 5
05.12.2012, 12:53  [ТС] 9
Скрипт, а можно хотя бы написать простенький, если бы надо было просто найти и вставить, без всех этих проверок. А дальше я уж сам постараюсь.
0
Скрипт
5446 / 1127 / 49
Регистрация: 15.09.2012
Сообщений: 3,420
05.12.2012, 12:55 10
PredatorUA, без предварительного преобразования сравниваемых строк? Имеется ввиду удаление пробелов, точек и другого.
0
PredatorUA
0 / 0 / 0
Регистрация: 04.12.2012
Сообщений: 5
05.12.2012, 13:34  [ТС] 11
Скрипт, да, именно так. Тупо вставить первую совпавшую ячейку.
0
Скрипт
5446 / 1127 / 49
Регистрация: 15.09.2012
Сообщений: 3,420
05.12.2012, 13:46 12
Код:
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sub Procedure_1()
 
    Dim shSheet_1 As Excel.Worksheet, shSheet_2 As Excel.Worksheet
    Dim sSheet_2Text As String
    Dim rFind As Excel.Range
    Dim iSheet_2 As Long
    
    'Даём имена листам, через которые будем к ним обращаться.
    'Имена даём для удобства написания кода.
    Set shSheet_1 = Worksheets(1)
    Set shSheet_2 = Worksheets(2)
    
    'Двигаемся на втором листе по столбцу "B", пока не встретим пустую ячейку.
    iSheet_2 = 1
    Do While IsEmpty(shSheet_2.Cells(iSheet_2, "B")) = False
    
        'Берём данные в переменную, чтобы удобнее было код писать.
        sSheet_2Text = shSheet_2.Cells(iSheet_2, "B").Value
        
        'Поиск.
        Set rFind = shSheet_1.Columns("B").Find(What:=sSheet_2Text, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
            
        'Если найдено.
        If Not rFind Is Nothing Then
            
            'Помещаем данные на второй лист.
            shSheet_2.Cells(iSheet_2, "A").Value = rFind.Offset(0, -1).Value
                
        End If
        
        'Переход к следующей строке на втором листе.
        iSheet_2 = iSheet_2 + 1
        
    Loop
    
End Sub
1
05.12.2012, 13:46
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
05.12.2012, 13:46

Поиск значений
Добрый вечер, подскажите пожалуйста. Суть проблемы в том что не могу найти...

Поиск значений
По заданию мне необходимо найти название игрушек, цена которых не превышает N...

Осуществление поиска в открытом окне Word по совпадению с данными ячейки Excel
Доброго времени суток, господа профессионалы! Подскажите, пожалуйста, как...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
12
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru