Как правильно реализовать поиск и замену в макросе MS Excel

SokeOner · 11 фев 2013, 22:21

Здравствуйте всем встретился с такой проблемой есть два прайсы в якикихе по два столбца в каждом название и цена, идя по порядку в прайсе "A" я ищу такое же название в прайсе "Б" есть в прайсе "А" продукт под номером 1 а в прайсе "Б" может быть под любым номером зависимости где он найдется поиском. Следующий шаг я перевожу курсор на 1 ячейку в право от активной (там где цена) но и сравниваю цену в прайсе "А" и "Б" тогда просто записываю ту цену которая меньше в прайс "А" из прайса "Б" или оставляю таким же если она ниже соответствующую цену в прайсе "Б".
Так вот в чем моя проблема:
Я написал алгоритv который это выполняет но никак не могу понять как мне в поиск записывать поочередно из прайса "А" ячейки 1,2,3,4, т.е. их значение для поиска в прайсе "Б" и изменения цены? ВОТ КОД

Sub Макрос13()
'
' Макрос13 Макрос
'

''
For i = 1 To 12

Sheets(3).Rows("1:12").Columns("A").Cells(i + 1).Copy

Sheets(4).Select

Range("A1:A13").Select
Selection.Find(What:=Insert, After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Select

ActiveCell.Offset(0, 1).Select

If ActiveCell.Value > _
Sheets(3).Rows("1:12").Columns(2).Cells(i + 1).Value _
Then ActiveCell.Value = _
Sheets(3).Rows("1:12").Columns(2).Cells(i + 1).Value

Next
End Sub
[/code] [/more]

pashulka · 11 фев 2013, 23:28

В случае, когда есть уверенность, что позиция из прайса "A" обязательно присутствует в прайсе "B", достаточно применить следующую формулу :

=МИН(ВПР(Лист3!A1;Лист4!$A$1:$B$13;2;0);Лист3!B1)

Но если Вы хотите воспользоваться именно поиском, то :

Код: Выделить всё

Private Sub Test()
    Dim iSourceA As Range, iSourceB As Range
    Dim iCellA   As Range, iCellB   As Range
    
    Set iSourceA = Worksheets(3).Range("A1:A12")
    Set iSourceB = Worksheets(4).Range("A1:A13")

    Application.ScreenUpdating = False
    
    For Each iCellA In iSourceA
        Set iCellB = iSourceB.Find(iCellA, , xlValues, xlWhole)
        If Not iCellB Is Nothing Then
           iCellA(1, 2) = Application.Min(iCellA(1, 2), iCellB(1, 2))
        End If
    Next
    
    Application.ScreenUpdating = True
End Sub

А если выкинуть все необходимые проверки, то :

Код: Выделить всё

Private Sub Test2()
    Dim iSourceB As Range, iCellA As Range
    Set iSourceB = Worksheets(4).Range("A1:A13")

    For Each iCellA In Worksheets(3).Range("A1:A12")
        iCellA(1, 2) = Application.Min( _
        iCellA(1, 2), iSourceB.Find(iCellA, , xlValues, xlWhole)(1, 2))
    Next
End Sub

SokeOner · 12 фев 2013, 00:53

pashulka писал(а):В случае, когда есть уверенность, что позиция из прайса "A" обязательно присутствует в прайсе "B", достаточно применить следующую формулу :

=МИН(ВПР(Лист3!A1;Лист4!$A$1:$B$13;2;0);Лист3!B1)

Но если Вы хотите воспользоваться именно поиском, то :
Код: Выделить всё
Private Sub Test()
    Dim iSourceA As Range, iSourceB As Range
    Dim iCellA   As Range, iCellB   As Range
    
    Set iSourceA = Worksheets(3).Range("A1:A12")
    Set iSourceB = Worksheets(4).Range("A1:A13")

    Application.ScreenUpdating = False
    
    For Each iCellA In iSourceA
        Set iCellB = iSourceB.Find(iCellA, , xlValues, xlWhole)
        If Not iCellB Is Nothing Then
           iCellA(1, 2) = Application.Min(iCellA(1, 2), iCellB(1, 2))
        End If
    Next
    
    Application.ScreenUpdating = True
End Sub
А если выкинуть все необходимые проверки, то :
Код: Выделить всё
Private Sub Test2()
    Dim iSourceB As Range, iCellA As Range
    Set iSourceB = Worksheets(4).Range("A1:A13")

    For Each iCellA In Worksheets(3).Range("A1:A12")
        iCellA(1, 2) = Application.Min( _
        iCellA(1, 2), iSourceB.Find(iCellA, , xlValues, xlWhole)(1, 2))
    Next
End Sub

дело в том что это должно быть автоматическая циклическая программа которая идет циклом и проверяет существует название строки на ячейки из прайса "А" в прайсе Б т.е. может быть 200 товаров 300 Нет! и впрямь желательно чтобы оно искало не идентичные результаты а подобные идентичные. спасибо

SokeOner · 12 фев 2013, 00:55

pashulka писал(а):В случае, когда есть уверенность, что позиция из прайса "A" обязательно присутствует в прайсе "B", достаточно применить следующую формулу :

и если не трудно можете прислать файл с вашим вариантом поиска в макросе типа пример как оно ищет и заменяет я не до конца понял принцип работы вашего кода

pashulka · 12 фев 2013, 19:58

Справедливости ради следует отменить, что стандартную функцию рабочего листа =ВПР() я предлагал использовать для поиска точного совпадения, впрочем, мы, разумеется, можем применить эту функцию или метод .Find в макросе, и для поиска частичных совпадений. Нужно только иметь ввиду, что в таком случае, при поиске наименования : втулка Р5 может быть найдена втулка Р50 хотя это разные изделия.

Что касается примера, то смотрите аттач.

SokeOner · 12 фев 2013, 21:05

pashulka писал(а):Справедливости ради следует отменить, что стандартную функцию рабочего листа =ВПР() я предлагал использовать для поиска точного совпадения, впрочем, .......
Что касается примера, то смотрите аттач.

Большое спасибо за подсказку работает все на Ура! Просто спасли ситуацию! могу вас как-то отблагодарить? Знаю что будет наглостью но я делал у себя в программе не правильно в той что с самого начала была описана? я попытался сравнить то кодив и то что вы не равняется оно совсем! т.е. вы делали совсем другим методом кажется! Хотя в вашем коде разобрался сразу когда увидел пример! Ну что я сделаю чайник я чайник.

SokeOner · 12 фев 2013, 21:15

pashulka писал(а):Справедливости ради следует отменить, что стандартную функцию рабочего листа =ВПР() я предлагал использовать для поиска ........................

Еще интересно можно сделать идентичен поиск только без учета знаков препинания тоесть запятых, точек, пробелов, черточек ТОЕСТЬ: "ERGO _V T-9-01 W_hite" равносильно "ERGOVT901White" этом "ERGO W T901 White" и этом "ERGO V Т-901 White ".

Вибачте можливо за неграмотність Російську знаю поганенько! розмовляю добре, а от пишу ..... погано

pashulka · 12 фев 2013, 21:34

SokeOner писал(а):Знаю что будет наглостью но я делал у себя в программе не правильно в той что с самого начала была описана? я попытался сравнить то кодив и то что вы не равняется оно совсем!

Если Вы хотите знать, что было неправильно в первоначальном варианте ... то вкратце -- Вы копировали ячейку в прайсе "A" и пытались вставить скопированные данные при поиске, однако, для макроса Insert это всего лишь неописанная переменная, т.е. по сути Вы искали Empty. Если же нужно просто переписать первоначальный вариант, то :

Код: Выделить всё

Sub Макрос13()

Dim i As Integer, c As Range

For i = 2 To 13
    Set c = Sheets(4).Range("A1:A13").Find( _
    What:=Sheets(3).Cells(i, 1), LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not c Is Nothing Then
       If c.Offset(, 1) > Sheets(3).Cells(i, 2) _
       Then c.Offset(, 1) = Sheets(3).Cells(i, 2)
    End If
Next

End Sub

pashulka · 12 фев 2013, 21:51

SokeOner писал(а):Еще интересно можно сделать идентичен поиск только без учета знаков препинания тоесть запятых, точек, пробелов, черточек ТОЕСТЬ: "ERGO _V T-9-01 W_hite" равносильно "ERGOVT901White" этом "ERGO W T901 White" и этом "ERGO V Т-901 White "

Для этого, нужно перед поиском - заменить все перечисленные символы на символ подстановки * а в последнем случае, ещё и добавить символ подстановки после искомого текста (если же пробел может наличествовать и перед исходным текстом, например " ERGO V Т-901 White ", то * нужно добавить ещё и вначале искомого текста)

Пардон, во втором случае, даже использование wildcards не прокатит, ибо "ERGO W T901 White" <> "ERGO V Т-901 White "

SokeOner · 13 фев 2013, 02:11

pashulka писал(а):Для этого, нужно перед поиском - заменить все перечисленные символы на символ подстановки * а в последнем случае, ещё и добавить символ подстановки после искомого текста ......................... "

Вы имеете в виду заменить эти символы пунктуации на "*" в ручную тоесть использовать стандартный способ замены и поиска? (то находящегося в панели инструментов)?