Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Поиск значения и раскладывание по разным ячейкам - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск значения и раскладывание по разным ячейкам (Макросы/Sub)
Поиск значения и раскладывание по разным ячейкам
Mikez Дата: Четверг, 26.05.2016, 05:55 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Есть функционал, сделанный формулами.
Спасибо @pabchek и @_Boroda_ вот тут помогли.

ПРОБЛЕМА:
На объёмах в несколько десятков тысяч строк Эксель становится колом. Одна и та же работа делается 3 раза.
А потом ещё нужно заменить на значения, что тоже занимает уйму времени.

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

ЛОГИКА
В двух ячейках (лист клиенты - колонки часть 1 и часть 2) ищем упоминание юрлица.
Массив с формами юрлиц на листе "Массивы", в диапазоне "Тип".
Массив неизменный, поэтому его можно спрятать в код макроса.

Если есть упоминание юрлица, то содержимое этой ячейки идёт в колонку "юрлицо".
И найденное упоминание записывается в "форма юрлица".
Иначе содержимое записывается в колонку "объект".

Спасибо.
К сообщению приложен файл: excel-_.__.xlsx (13.2 Kb)
 
Ответить
СообщениеЕсть функционал, сделанный формулами.
Спасибо @pabchek и @_Boroda_ вот тут помогли.

ПРОБЛЕМА:
На объёмах в несколько десятков тысяч строк Эксель становится колом. Одна и та же работа делается 3 раза.
А потом ещё нужно заменить на значения, что тоже занимает уйму времени.

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

ЛОГИКА
В двух ячейках (лист клиенты - колонки часть 1 и часть 2) ищем упоминание юрлица.
Массив с формами юрлиц на листе "Массивы", в диапазоне "Тип".
Массив неизменный, поэтому его можно спрятать в код макроса.

Если есть упоминание юрлица, то содержимое этой ячейки идёт в колонку "юрлицо".
И найденное упоминание записывается в "форма юрлица".
Иначе содержимое записывается в колонку "объект".

Спасибо.

Автор - Mikez
Дата добавления - 26.05.2016 в 05:55
KuklP Дата: Четверг, 26.05.2016, 07:17 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Можно так попробовать, но скорость будет зависеть от к-ва юрлиц:
[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]


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеМожно так попробовать, но скорость будет зависеть от к-ва юрлиц:
[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]

Автор - KuklP
Дата добавления - 26.05.2016 в 07:17
KuklP Дата: Четверг, 26.05.2016, 07:20 | Сообщение № 3
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Да, это в модуль листа клиенты.


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеДа, это в модуль листа клиенты.

Автор - KuklP
Дата добавления - 26.05.2016 в 07:20
Mikez Дата: Четверг, 26.05.2016, 13:36 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Да, это в модуль листа клиенты.

Почти то что нужно. Спасибо.

Во вложении я заполнил колонку "объект" как будто макрос отработал верно.

Колонка "объект" не должна пустовать, а должна быть заполнена из колонки "часть 1".
Когда в "часть 1" обнаружено юрлицо. Тогда "объект" должен содержать "часть2".
Выделил этот случай красным в примере.

Я совсем ноль в VBA, подскажите как это сделать, пожалуйста.
Спасибо.
К сообщению приложен файл: excel-_.__.xlsm (19.0 Kb)


Сообщение отредактировал Mikez - Четверг, 26.05.2016, 13:37
 
Ответить
Сообщение
Да, это в модуль листа клиенты.

Почти то что нужно. Спасибо.

Во вложении я заполнил колонку "объект" как будто макрос отработал верно.

Колонка "объект" не должна пустовать, а должна быть заполнена из колонки "часть 1".
Когда в "часть 1" обнаружено юрлицо. Тогда "объект" должен содержать "часть2".
Выделил этот случай красным в примере.

Я совсем ноль в VBA, подскажите как это сделать, пожалуйста.
Спасибо.

Автор - Mikez
Дата добавления - 26.05.2016 в 13:36
KuklP Дата: Пятница, 27.05.2016, 05:04 | Сообщение № 5
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Тогда такой принцип вообще не подойдет. И непонятно, почему тогда:
Фотосалон
Фотосалон ИП Медведев Ю.А.
В столбе объект в примере не заполнены.


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728
 
Ответить
СообщениеТогда такой принцип вообще не подойдет. И непонятно, почему тогда:
Фотосалон
Фотосалон ИП Медведев Ю.А.
В столбе объект в примере не заполнены.

Автор - KuklP
Дата добавления - 27.05.2016 в 05:04
KuklP Дата: Пятница, 27.05.2016, 05:33 | Сообщение № 6
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Попробуйте:
[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
[/vba]
К сообщению приложен файл: _excel-1.xlsm (19.8 Kb)


Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728


Сообщение отредактировал KuklP - Пятница, 27.05.2016, 05:39
 
Ответить
СообщениеПопробуйте:
[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
[/vba]

Автор - KuklP
Дата добавления - 27.05.2016 в 05:33
Mikez Дата: Пятница, 27.05.2016, 07:32 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Благодарю!
 
Ответить
СообщениеБлагодарю!

Автор - Mikez
Дата добавления - 27.05.2016 в 07:32
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск значения и раскладывание по разным ячейкам (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!