Есть функционал, сделанный формулами. Спасибо @pabchek и @_Boroda_ вот тут помогли.
ПРОБЛЕМА: На объёмах в несколько десятков тысяч строк Эксель становится колом. Одна и та же работа делается 3 раза. А потом ещё нужно заменить на значения, что тоже занимает уйму времени.
Помогите, пожалуйста, как данную логику отобразить в макросе.
ЛОГИКА В двух ячейках (лист клиенты - колонки часть 1 и часть 2) ищем упоминание юрлица. Массив с формами юрлиц на листе "Массивы", в диапазоне "Тип". Массив неизменный, поэтому его можно спрятать в код макроса.
Если есть упоминание юрлица, то содержимое этой ячейки идёт в колонку "юрлицо". И найденное упоминание записывается в "форма юрлица". Иначе содержимое записывается в колонку "объект".
Спасибо.
Есть функционал, сделанный формулами. Спасибо @pabchek и @_Boroda_ вот тут помогли.
ПРОБЛЕМА: На объёмах в несколько десятков тысяч строк Эксель становится колом. Одна и та же работа делается 3 раза. А потом ещё нужно заменить на значения, что тоже занимает уйму времени.
Помогите, пожалуйста, как данную логику отобразить в макросе.
ЛОГИКА В двух ячейках (лист клиенты - колонки часть 1 и часть 2) ищем упоминание юрлица. Массив с формами юрлиц на листе "Массивы", в диапазоне "Тип". Массив неизменный, поэтому его можно спрятать в код макроса.
Если есть упоминание юрлица, то содержимое этой ячейки идёт в колонку "юрлицо". И найденное упоминание записывается в "форма юрлица". Иначе содержимое записывается в колонку "объект".
Можно так попробовать, но скорость будет зависеть от к-ва юрлиц: [vba]
Код
Public Sub www() Dim a, i&, c As Range, fa$ a = [тип2].Value With Intersect(Me.[k:l], Me.UsedRange) For i = 1 To UBound(a) Set c = .Find(a(i, 1), , xlValues, xlPart, MatchCase:=True) If Not c Is Nothing Then fa = c.Address Do Cells(c.Row, 15) = c: Cells(c.Row, 16) = a(i, 1) Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> fa End If Next End With End Sub
[/vba]
Можно так попробовать, но скорость будет зависеть от к-ва юрлиц: [vba]
Код
Public Sub www() Dim a, i&, c As Range, fa$ a = [тип2].Value With Intersect(Me.[k:l], Me.UsedRange) For i = 1 To UBound(a) Set c = .Find(a(i, 1), , xlValues, xlPart, MatchCase:=True) If Not c Is Nothing Then fa = c.Address Do Cells(c.Row, 15) = c: Cells(c.Row, 16) = a(i, 1) Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> fa End If Next End With End Sub
Во вложении я заполнил колонку "объект" как будто макрос отработал верно.
Колонка "объект" не должна пустовать, а должна быть заполнена из колонки "часть 1". Когда в "часть 1" обнаружено юрлицо. Тогда "объект" должен содержать "часть2". Выделил этот случай красным в примере.
Я совсем ноль в VBA, подскажите как это сделать, пожалуйста. Спасибо.
Во вложении я заполнил колонку "объект" как будто макрос отработал верно.
Колонка "объект" не должна пустовать, а должна быть заполнена из колонки "часть 1". Когда в "часть 1" обнаружено юрлицо. Тогда "объект" должен содержать "часть2". Выделил этот случай красным в примере.
Я совсем ноль в VBA, подскажите как это сделать, пожалуйста. Спасибо.Mikez
Public Sub www() Dim a, b, i&, j&, f As Boolean b = [тип2].Value a = Intersect(Me.[k:p], Me.UsedRange).Value f = -1 For i = 2 To UBound(a) For j = 1 To UBound(b) If InStr(a(i, 1), b(j, 1)) Then a(i, 5) = a(i, 1): a(i, 6) = b(j, 1): a(i, 4) = a(i, 2) f = 0 Exit For End If If InStr(a(i, 2), b(j, 1)) Then a(i, 5) = a(i, 2): a(i, 6) = b(j, 1): a(i, 4) = a(i, 1) f = 0 Exit For End If Next If f And a(i, 2) = "" Then a(i, 4) = a(i, 1) f = -1 Next [k1].Resize(UBound(a), 6) = a End Sub
[/vba]
Попробуйте: [vba]
Код
Public Sub www() Dim a, b, i&, j&, f As Boolean b = [тип2].Value a = Intersect(Me.[k:p], Me.UsedRange).Value f = -1 For i = 2 To UBound(a) For j = 1 To UBound(b) If InStr(a(i, 1), b(j, 1)) Then a(i, 5) = a(i, 1): a(i, 6) = b(j, 1): a(i, 4) = a(i, 2) f = 0 Exit For End If If InStr(a(i, 2), b(j, 1)) Then a(i, 5) = a(i, 2): a(i, 6) = b(j, 1): a(i, 4) = a(i, 1) f = 0 Exit For End If Next If f And a(i, 2) = "" Then a(i, 4) = a(i, 1) f = -1 Next [k1].Resize(UBound(a), 6) = a End Sub