Добрый день! Есть столбец с контрагентами, мне нужно определять кто они: ИП, физ.лицо или юр.лицо. Есть лист с выгруженными юр.лицами на 250 000 позиций. Макрос перебором смотрит есть ли там такая позиция, если нет, то, на всякий случай проверяет на наличие ООО, ЗАО, ПАО, БАНК в названии и т.д. (в настоящем макросе побольше условий). И если ничего не нашлось, то считается, что это физ.лицо. (запускал на 3000 позиций, один промах был, но для моих целей сойдет) Так вот, но это ужасно долго, этот перебор очень медленный. Как можно перебор по этому справочнику ускорить? ВПР в сто раз быстрей же считает. Можно, наверное, в функцию засунуть впр и если #ND, то уже проверить остальные условия...но нет ли более красивого и при этом быстрого решения?
Спасибо.
КОД
Код
Function КАТПЛАТЕЛЬЩИК$(txt$)
iLastRow = ThisWorkbook.Worksheets("Справочник ЮЛ-ИП").Cells(Rows.Count, 1).End(xlUp).Row
Set dirSheet = ThisWorkbook.Worksheets("Справочник ЮЛ-ИП")
For i = 1 To iLastRow
If LCase(txt) = LCase(dirSheet.Cells(i, 1).Value) Then КАТПЛАТЕЛЬЩИК = dirSheet.Cells(i, 2).Value: Exit Function
Next i
'----------посчитаем кол-во слов--------------------------------------------------
b = Trim(txt)
j = 0
For k = 1 To Len(b)
x = Mid(b, k, 1)
If x = " " Then j = j + 1
Next k
qWords = j + 1
'--------------------------------------------------------------------------------
If qWords > 2 Then
txt = Trim(txt)
Select Case True
'Case txt Like "ООО *": КАТПЛАТЕЛЬЩИК = "Юр.лицо"
'Case txt Like "* ООО *": КАТПЛАТЕЛЬЩИК = "Юр.лицо"
Case txt Like "АО *": КАТПЛАТЕЛЬЩИК = "Юр.лицо": Exit Function
Case txt Like "* АО": КАТПЛАТЕЛЬЩИК = "Юр.лицо": Exit Function
Case txt Like "ИП *": КАТПЛАТЕЛЬЩИК = "ИП": Exit Function
Case txt Like "* ИП": КАТПЛАТЕЛЬЩИК = "ИП": Exit Function
'Case Else: Category = "Физ.лицо"
End Select
End If
КАТПЛАТЕЛЬЩИК = "Уточнить"
End Function
whateverlover, считать количество слов так не сильно здорово, Если предварительно пройти тримером и сравнить это и удалив все пробелы по длинне, то получите количество слов -1.
А как быть с поиском по справочнику? (в справочнике, кстати, есть как юрики, так и ИП, поэтому пробую искать по первому столбцу, а тип контрагента беру уже из второго)
Ещё вариант если список ФИО не меняется - - объявляем публичный словарь (можно на уровне модуля, или статик) - при первом вызове функции его заполняем, и используем - при следующих сразу используем
P.S. вот вроде работает, можете мелочи шлифовать... Там с этим массивом я например прописал как проще на моём файле. Кстати обнаружил неописанную хрень с CurrentRegion, убил на это пару минут...
Скрытый текст
Код
Function КАТПЛАТЕЛЬЩИК$(txt$)
Static d As Object
Dim a, i&, t$, qWords
txt = Trim(txt)
If d Is Nothing Then
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = 1
'a = ThisWorkbook.Worksheets("Справочник ЮЛ-ИП").Range("A1").CurrentRegion.Value 'не работает в UDF!
a = ThisWorkbook.Worksheets("Справочник ЮЛ-ИП").UsedRange.Value
For i = 1 To UBound(a)
t = Trim(a(i, 1))
d.Item(t) = a(i, 2)
Next
a = Empty
End If
If d.exists(txt) Then КАТПЛАТЕЛЬЩИК = d.Item(txt): Exit Function
КАТПЛАТЕЛЬЩИК = "Уточнить"
'----------посчитаем кол-во слов--------------------------------------------------
qWords = UBound(Split(txt))
'--------------------------------------------------------------------------------
If qWords > 0 Then
Select Case True
Case txt Like "ООО *": КАТПЛАТЕЛЬЩИК = "Юр.лицо"
Case txt Like "* ООО *": КАТПЛАТЕЛЬЩИК = "Юр.лицо"
Case txt Like "АО *": КАТПЛАТЕЛЬЩИК = "Юр.лицо"
Case txt Like "* АО": КАТПЛАТЕЛЬЩИК = "Юр.лицо"
Case txt Like "ИП *": КАТПЛАТЕЛЬЩИК = "ИП"
Case txt Like "* ИП": КАТПЛАТЕЛЬЩИК = "ИП"
Case Else: КАТПЛАТЕЛЬЩИК = "Уточнить"
End Select
End If
End Function
а в идеале один раз Тримером пройти в начале обработки ,ведь потом это делается еще раз, но уже для поиска.
По поводу массива вместо листа или словаря
Код
a = ThisWorkbook.Worksheets("Справочник ЮЛ-ИП").UsedRange.Value
- не знаю что там на листе, может есть лишние колонки, так что лучше
Код
With ThisWorkbook.Worksheets("Справочник ЮЛ-ИП")
a = Intersect(Range("A:B"),.UsedRange).Value
End with
В идеале сравнить с ВПР , может и словарь не потребуется. КАТПЛАТЕЛЬЩИК = WorksheetFunction.VLookup(txt, ThisWorkbook.Worksheets("Справочник ЮЛ-ИП").Range("A:B"), 2, False)
На моём листе нет лишних колонок А вообще нужно знать как это дело будет применяться - если будет например подтягиваться для одного значения, или десятка - можно и ВПРом пройтись, не особо будет заметны потери времени. Ну а если нужно обработать список из десятков тысяч (протянув формулу по столбцу), то думаю словарь должен вырвать очко