Страницы: 1
RSS
If vlookup не находит, то.., VBA. Vlookup.
 
Здравствуйте.
В столбце B хочу расставить бренды.
В конце наименования запчасти последнее слово - бренд. Пример (АМОРТИЗАТОР ACC RUS ПЕР ЛЕВ ABS KAYABA).
KAYABA  - бренд, который есть в диапазоне М1:М32. Если в конце наименования нет бренда значит он находится в таблице, в столбце D (D7). Там уже идут автопроизводители  - HYUNDAI, KIA и т.д. Вроде бренды расставляет макрос, а автопроизводителей не хочет.
b = WorksheetFunction.VLookup(a, Range("M1:M132"), 1, 0) - где-то тут пишет ошибка.
Подскажите, где я ошибаюсь.
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
Владимир,
Код
  On Error Resume Next
  For i = 8 To lastrow
    a = Split(Cells(i, 5), " ")(UBound(Split(Cells(i, 5), " ")))
    b = WorksheetFunction.VLookup(a, ActiveSheet.Range("M1:M132"), 1, False)
    If Err.Number <> 0 Then
      Cells(i, 2) = brend(shet)
      Err.Clear
    Else
      Cells(i, 2) = b
    End If
  Next
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
Или так
Код
Sub price()
Dim i As Integer, shet As Byte, lastrow As Integer
Dim a As String, b ' As String
Dim brend
brend = Array("HYUNDAI", "MITSUBISHI", "NISSAN", "TOYOTA", , , "HYUNDAI", "Книга", , "DONGIL")
lastrow = Cells(Rows.Count, 5).End(xlUp).Row
    For i = 8 To lastrow
    a = Split(Cells(i, 5), " ")(UBound(Split(Cells(i, 5), " ")))
    b = Application.VLookup(a, Range("M1:M132"), 1, 0)
         If IsError(b) Then
            Cells(i, 2) = brend(shet)
         Else
            Cells(i, 2) = b
        End If
    Next
End Sub
 
Ошибка потому что нет совпадений.
Код
        If IsError(Application.VLookup(a, Range("M1:M132"), 1, 0)) Then
            Cells(i, 2) = brend(shet)
        Else
            Cells(i, 2) = Application.VLookup(a, Range("M1:M132"), 1, 0)
        End If

Изменено: Hugo - 17.03.2015 14:44:09
 
Алексей, Игорь, Саша - спасибо большое. Это мне понятно - If IsError(Application.VLookup(a, Range("M1:M132"), 1, 0)) Then
А как понять эти строки?
If Err.Number <> 0 Then
     Err.Clear

Если ошибка не равна нулю, то очищение ошибки. Так?
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
Так.
 
чтобы пойманная функцией ошибка не фигурировала на следующем заходе цикла
F1 творит чудеса
 
Скрытый текст

Ребята, подскажите пожалуйста, что я такого ужасного нагородил, что у меня макрос работает аж 10 минут?
Изменено: Владимир - 20.03.2015 13:44:06
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
Да ничего особенного. Просто для этого объема данных нужен другой макрос.
Этот в цикле обращается к ячейкам листа, поштучно вставляет формулы...
Изменено: RAN - 20.03.2015 13:44:48
 
Добрый день
Попробуйте отключить пересчет формул, обновление экрана и т.д.
 
Понятно. Будем учиться писать другим способом.
Спасибо.
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
Как вариант
Код
Sub qq()
Dim odic As Object
Dim arr, arrB, i&, brend$, x
    arrB = Range(Cells(1, "M"), Cells(Rows.Count, "M").End(xlUp)).Value
    Set odic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arrB)
        odic.Item(Application.Trim(arrB(i, 1))) = 1
    Next
    arr = Range(Cells(8, "B"), Cells(Rows.Count, "E").End(xlUp)).Value
    brend = Split(Cells(7, "D"), " ", 2)(0)
    For i = 1 To UBound(arr)
        x = Application.Trim(Split(arr(i, 4))(UBound(Split(arr(i, 4)))))
        If odic.exists(x) Then
            arr(i, 1) = x
        Else
            arr(i, 1) = brend
        End If
    Next
    Range("B8").Resize(UBound(arr), 1) = arr
End Sub
 
Item
Method
Returns a specific member of a Collection object either by position or by key.

Я так понимаю, что ITEM - это возвращение номера позиции из коллекции?
А что такое  - exists?

Остальное вроде понятно. Только эта строка ошибку выдаёт.
x = Application.Trim(Split(arr(i, 4))(UBound(Split(arr(i, 4)))))
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
Про словари можно почитать здесь
 
Код
odic.Item(Application.Trim(arrB(i, 1))) = 1

Для словарей это имеет немного другой смысл, чем в коллекциях. фактически, odic(x)=1 и odic.Item(x)=1 это одно и то же - присвоение элементу словаря с ключом x значения 1. Разница в том, что если такой ключ не существует, первая запись вызовет ошибку, вторая - добавит отсутствующий элемент. Если ключ уже есть в словаре, то оба варианта просто перезапишут значение, присвоенное ключу.
В коллекциях так нельзя, если ключа нет, его надо добавлять через .Add

Но есть и проверка существования ключа в словаре - делается как раз через .Exists:
Код
If odic.exists(x) then ' если в словаре есть ключ х то...


И по индексу к элементу словаря, по-моему, тоже не обратиться напрямую.
Цитата
Владимир написал:
Только эта строка ошибку выдаёт.
x = Application.Trim(Split(arr(i, 4))(UBound(Split(arr(i, 4)))))
возможно, Split не удалось разбить arr(i, 4) на части и создать массив (например, это только одна строка без пробелов). Тогда ее результат будет не массив, а простая переменная, к которой нельзя применить UBound.
F1 творит чудеса
 
Спасибо. Буду разбираться.
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
Цитата
Максим Зеленский написал: Тогда ее результат будет не массив...
массив. из одного элемента с индексом 0.
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
ikki, да, что-то я погорячился. Тогда пока не понял, в чем ошибка там.
F1 творит чудеса
 
Split дает ошибку при Empty и "".

Код
Sub qq()
    Dim odic As Object
    Dim arr, arrB, i&, brend$, x
    arrB = Range(Cells(1, "M"), Cells(Rows.Count, "M").End(xlUp)).Value
    Set odic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arrB)
        odic.Item(Application.Trim(arrB(i, 1))) = 1
    Next
    arr = Range(Cells(8, "B"), Cells(Rows.Count, "E").End(xlUp)).Value
    brend = Split(Cells(7, "D"), " ", 2)(0)
    On Error Resume Next
    For i = 1 To UBound(arr)
        x = Application.Trim(Split(arr(i, 4))(UBound(Split(arr(i, 4)))))
        If Err Then
            arr(i, 1) = Empty: Err.Clear
        Else
            If odic.exists(x) Then
                arr(i, 1) = x
            Else
                arr(i, 1) = brend
            End If
        End If
    Next
    Range("B8").Resize(UBound(arr), 1) = arr
End Sub
Изменено: RAN - 21.03.2015 14:05:51
Страницы: 1
Наверх