Сравнение диапазона ячеек с множеством условий

@scratganibal · Регистрация: 16.10.2012

Author24 — интернет-сервис помощи студентам

Здравствуйте! Прилагаю код, работает долго, поскольку обработка идет по диапазону 300 000 строк и 32 столбца, как можно оптимизировать быстроту сравнения с множеством условий? и как можно эти условия не прописывать в коде и где нить на отдельном листе книги? какие операторы могут ускорить работу? Помогите, не могу оптимизировать, работа макроса занимает 30-40 минут

Visual Basic

y = Worksheets("Отчет").Cells(Rows.Count, 1).End(xlUp).Row
    For i1 = 6 To y
        If Worksheets("Отчет").Cells(i1, 30).Value = " " Then
            Worksheets("Отчет").Cells(i1, 30).Value = Worksheets("Отчет").Columns(28).Cells(i1).Value
            Worksheets("Отчет").Cells(i1, 29).Value = Worksheets("Отчет").Columns(27).Cells(i1).Value
        End If
        
        If Worksheets("Отчет").Cells(i1, 26).Value = "Город1" Then
            
            If Worksheets("Отчет").Cells(i1, 16).Value Like "*залог1*" Or _
Worksheets("Отчет").Cells(i1, 16).Value Like "*залог2*" Or _
Worksheets("Отчет").Cells(i1, 21).Value Like "*Банк1*" Or _
Worksheets("Отчет").Cells(i1, 20).Value Like "*продукт - К*" Or _
Worksheets("Отчет").Cells(i1, 20).Value Like "*продукт - З*" Then
                Worksheets("Отчет").Cells(i1, 31).Value = "ДПП"
            End If
            If Worksheets("Отчет").Cells(i1, 21).Value Like "*ФИО1*" Or _
Worksheets("Отчет").Cells(i1, 21).Value Like "*ФИО2*" Or _
Worksheets("Отчет").Cells(i1, 21).Value Like "*ФИО3*" Or _
Worksheets("Отчет").Cells(i1, 21).Value Like "*ФИО4*" Or _
Worksheets("Отчет").Cells(i1, 21).Value Like "*ФИО5*" Or _
Worksheets("Отчет").Cells(i1, 21).Value Like "*ФИО6*" Or _
Worksheets("Отчет").Cells(i1, 21).Value Like "*ФИО7*" Then
                Worksheets("Отчет").Cells(i1, 31).Value = "Глобал"
            End If
            If Worksheets("Отчет").Cells(i1, 31).Value = Empty Then
                Worksheets("Отчет").Cells(i1, 31).Value = "ДКС"
            End If
            If Worksheets("Отчет").Cells(i1, 11).Value = "уровень1" Or _
    Worksheets("Отчет").Cells(i1, 11).Value = "уровень2" Then
                Worksheets("Отчет").Cells(i1, 31).Value = "ДМС"
            End If
        End If
        If Worksheets("Отчет").Cells(i1, 26).Value <> "Город1" Then
            Worksheets("Отчет").Cells(i1, 31).Value = Worksheets("Отчет").Cells(i1, 26).Value
        End If
        
        If Worksheets("Отчет").Cells(i1, 29).Value = "счет1" And _
        Worksheets("Отчет").Cells(i1, 10).Value Like "*возрат1*" Then
            Worksheets("Отчет").Cells(i1, 31).Value = "Вход"
        End If
        
        If Worksheets("Отчет").Cells(i1, 29).Value = "счет2" Then
            Worksheets("Отчет").Cells(i1, 31).Value = "Вход"
        End If
        
    Next i1
 
Sub 2()
    ' процедура группировки по установленной форме отчетности
    ty = Worksheets("Отчет").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 6 To ty
        For g = 12 To 88
            For g1 = 3 To 29
                If Worksheets("Расчет").Cells(g, 2).Value = Worksheets("Отчет").Cells(i, 11).Value And _
           Worksheets("Расчет").Cells(7, g1).Value = Worksheets("Отчет").Cells(i, 31).Value Then
                    If Worksheets("Расчет").Cells(g, 32).Value = Worksheets("Отчет").Cells(i, 29).Value Or _
                 Worksheets("Расчет").Cells(g, 33).Value = Worksheets("Отчет").Cells(i, 29).Value Then
                        a2 = Val(Worksheets("Отчет").Cells(i, 30).Value)
                        Worksheets("Отчет").Cells(i, 32).Value = "!"
                        a22 = a2 / 1000
                        Worksheets("Расчет").Cells(g, g1).Value = Worksheets("Расчет").Cells(g, g1).Value + a22
                        GoTo f5
                    End If
                End If
        Next g1, g
f5: Next i
 
end sub

@Alex77755 · 20.12.2012, 17:16

Однозначно не работать с данными на листах: самы медленные операци - чтение и запись.
Считывать всё в массив.

Visual Basic

1
2
3

    For i = 6 To ty
        For g = 12 To 88
            For g1 = 3 To 29

Вот это тоже лучше выкинуть и воспользоваться словарём

Добавлено через 5 минут

Visual Basic

Worksheets("Отчет").Cells(i1, 21).Value Like "*ФИО2*" Or _
Worksheets("Отчет").Cells(i1, 21).Value Like "*ФИО3*" Or _
Worksheets("Отчет").Cells(i1, 21).Value Like "*ФИО4*" Or _
Worksheets("Отчет").Cells(i1, 21).Value Like "*ФИО5*" Or _
Worksheets("Отчет").Cells(i1, 21).Value Like "*ФИО6*" Or _
Worksheets("Отчет").Cells(i1, 21).Value Like "*ФИО7*" Then

Если Like, то может проще просто "ФИО" искать? или там могут быть ФИО8, ФИО9, ФИО0?

@Hugo121 · 20.12.2012, 18:10

Словарь с LIKE не дружит - придётся всё равно циклом перебирать.
А вот всю эту кучу OR я бы заменил на select case true - так хоть не придётся проверять каждый раз все условия. Или вообще RegExp привлечь нужно.
Ну и конечно всё нужно делать в массивах, а не на листе - я как-то мерил, массив в 47 раз был быстрее.
На одном форуме давно удалось подобный код ускорить с 40 мин. до 5,5 сек - и это ещё без использования словаря (давно было, ещё не освоил никто...

)

Добавлено через 2 минуты
А все AND заменил на вложенные IF-THEN-END IF

@Alex77755 · 20.12.2012, 18:29

То что словарь не дружит с Like, не может однозначно служить основанием отказа от него.
Мы же не видим файла, не знаем формата записей.
Разные бывают случаи. Возможно от Like можно(и нужно) будет отказаться

@scratganibal · 20.12.2012, 20:41 **[ТС]**

То есть мне надо всю информацию с исходника считать в массив, и далее обрабатывать уже массив, и далее записать результат в расчет?. Будьте добры небольшой какой нибудь пример со словарем написать пожалуйста. Дело в том что цель, что те критерия (условия) бывают динамичными, то есть постоянно что то меняется, добавляется и удаляется, поэтому хотелось бы не в коде добавлять и удалять, а допустим на листе с названием "справочник", хотя не имеет разницы, но можно уже не править внутри кода)).

Visual Basic

For i = 6 To ty  'длина исходника
      
'здесь же перебирает инфо с исходника для вставки в установленной форму, где с 12 по 88 расположен перечень, с 3 по 29 столбец 
  For g = 12 To 88
            For g1 = 3 To 29

убрать все не получится))

Добавлено через 10 минут

Сообщение от Alex77755

Если Like, то может проще просто "ФИО" искать? или там могут быть ФИО8, ФИО9, ФИО0?

Да там порядком до 6 фамилий, причем склонение может быть разное, порою где то одну букву пропустили, или нету букву забили, приходится середину брать, хоть она везде одинакова, просто эту базу забивают каждый раз разный работник

Добавлено через 3 минуты

Сообщение от Alex77755

Visual Basic

1
2
3

For i = 6 To ty
 For g = 12 To 88
 For g1 = 3 To 29

Вот это тоже лучше выкинуть и воспользоваться словарём

Просветите неразборчивого, что за словарь??

@Alex77755 · 20.12.2012, 22:11

Дело в том, что и примеров в сети достаточчно и надо понимать, что, в основном, всё зависит от формата данных.
И не видя ваших данных трудно понять, что надо.
Если вы хотите иметь более-менее подходяще решение выложите образец файла-источника и образец желаемого полученного результата.

Добавлено через 2 минуты
Объект Dictionary входит в не подключаемую по умолчанию библиотеку Microsoft Scripting Runtime поэтому для его использования, необходимо:
— либо заранее ("раннее связывание") устанавливать ссылку на эту библиотеку в References проекта, тогда словарь объявляется как:

Visual Basic

1	Dim oDict As Dictionary: Set oDict = New Dictionary

— либо объявлять его по ходу программы ("позднее связывание"):

Visual Basic

1	Dim oDict: Set oDict = CreateObject("Scripting.Dictionary")

@scratganibal · 21.12.2012, 07:51 **[ТС]**

Прикрепляю исходник и желаемый результат (в последнем имеется и сам код)

@scratganibal · 21.12.2012, 10:03 **[ТС]**

Сообщение от Alex77755

Дело в том, что и примеров в сети достаточчно и надо понимать, что, в основном, всё зависит от формата данных.
И не видя ваших данных трудно понять, что надо.
Если вы хотите иметь более-менее подходяще решение выложите образец файла-источника и образец желаемого полученного результата.

Извините, более сокращенный в размерах прикрепляю

@Hugo121 · 21.12.2012, 10:43

Словарь тут точно можно использовать вместо поиска по Worksheets("Виды") - уже будет экономия.
В общем, думаю тут тоже можно до 5 секунд сократить

Хотя может и нет - сейчас импорт этих "$A$1:$AD$262323" уже занимает 2 секунды.

@scratganibal · 21.12.2012, 11:02 **[ТС]**

[QUOTE=Hugo121;3894020]Словарь тут точно можно использовать вместо поиска по Worksheets("Виды") - уже будет экономия.
В общем, думаю тут тоже можно до 5 секунд сократить

Хотя может и нет - сейчас импорт этих "$A$1:$AD$262323" уже занимает 2 секунды.[/

К сожалению я не имею пока представления об использовании словарей....

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

@Hugo121 · 21.12.2012, 11:29

У Вас массив уже используется при импорте данных

Писать рабочий код на этом примере влом - слишком уж там всего много...
Но я тут рядом давал пару кодов на словаре: Как создать массив массивов
Смысл в чём - в начале кода из данных листа "Вид" заполняем словарь, затем когда нужно не ищем файндом на листе, а смотрим, есть ли такое в словаре. Быстро и код простой.

@Alex77755 · 21.12.2012, 13:24

в массив по любому считать надо.
Примерно так:

Visual Basic

    y = Worksheets("Отчет").Cells(Rows.Count, 1).End(xlUp).Row'определили последнюю запись
 Dim M()'объявили массив
 M = Range(Cells(6, 1), Cells(y, 31))' считали в массив
     For i1 = 6 To y'по всем строкам как и ранше
            If M(i1, 31) = " " Then' проверяем
           м(i1, 31) = "ДКС" ' только пишем не на лист, а в массив
    Next
Range(Cells(6, 1), Cells(y, 31)) = M 'после выполнения вываливаем массив на лист

На счёт Like. если бы были известно полное содержание ячеек можно было бы на отдельном листе записать в таблицу соответствия замен и загнать их в словарь. А с Like в олову только пришло: так же записать на лист соответствия и считать в отдельный массив. Но придётся добавлять ещё циклы по фамилиям

@scratganibal · 21.12.2012, 14:36 **[ТС]**

[QUOTE=Alex77755;3894653]в массив по любому считать надо.
Примерно так:

Visual Basic

    y = Worksheets("Отчет").Cells(Rows.Count, 1).End(xlUp).Row'определили последнюю запись
 Dim M()'объявили массив
 M = Range(Cells(6, 1), Cells(y, 31))' считали в массив
     For i1 = 6 To y'по всем строкам как и ранше
            If M(i1, 31) = " " Then' проверяем
           м(i1, 31) = "ДКС" ' только пишем не на лист, а в массив
    Next
Range(Cells(6, 1), Cells(y, 31)) = M 'после выполнения вываливаем массив на лист

На счёт Like. если бы были известно полное содержание ячеек можно было бы на отдельном листе записать в таблицу соответствия замен и загнать их в словарь. А с Like в олову только пришло: так же записать на лист соответствия и считать в отдельный массив. Но придётся добавлять ещё циклы по фамилиям

а как решить вопрос с типами данных??))

@Alex77755 · 21.12.2012, 16:03

А что? вызывает ошибку что-то?
Тип не объявлен - значит вариант - принимает любые значения

@scratganibal · 21.12.2012, 16:29 **[ТС]**

Сообщение от Alex77755

А что? вызывает ошибку что-то?
Тип не объявлен - значит вариант - принимает любые значения

по умолчанию при объявления массива принято как вариант, и пробовал объявить, дает ошибку несоотвествия типа данных

Visual Basic

Sub подстановка_под_нужное_условие()
    Dim arr()
    Worksheets("Отчет").Activate
    Columns(4).ClearContents
    sAddress = ActiveSheet.UsedRange.Address
    arr = Range(sAddress)
    iRowH = LBound(arr)
    iRowE = UBound(arr)
    iColumH = LBound(arr, 2)
    iColumE = UBound(arr, 2)
    
    For i1 = iRowH To iRowE
        If arr(i1, 30) = " " Then
            arr(i1, 30) = arr(i1, 28)
            arr(i1, 29) = arr(i1, 27)
        End If
        
        If arr(i1, 26) = "Алматы" Then
            
            If arr(i1, 16) Like "*алог*" Or _
                    arr(i1, 16) Like "*ретьи*" Or _
                    arr(i1, 21) Like "*Казкоммерцбан.Алматы*" Or _
                     arr(i1, 20) Like "*Стандартный продукт - К*" Or _
                      arr(i1, 20) Like "*Стандартный продукт - З*" Then
                
                arr(i1, 4) = "ДПП"
            End If
            If arr(i1, 21) Like "*Башеева*" Or _
                    arr(i1, 21) Like "*Ерасилов*" Or _
                    arr(i1, 21) Like "*Байзакова*" Or _
                 arr(i1, 21) Like "*Джолдыбаева*" Or _
                    arr(i1, 21) Like "*Катаева*" Or _
                     arr(i1, 21) Like "*Буриева*" Or _
                        arr(i1, 21) Like "*урахамед*" Then
                arr(i1, 4) = "Глобал"
            End If
            If arr(i1, 4) = Empty Then
                arr(i1, 4) = "ДКС"
            End If
            If arr(i1, 11) = "   - страхование на случай болезни" Or _
    arr(i1, 11) = "   - страхование от несчастных случаев" Then
                arr(i1, 4) = "ДМС"
            End If
        End If
        If arr(i1, 26) <> "Алматы" Then
            arr(i1, 4) = arr(i1, 26)
        End If
        
        If arr(i1, 29) = "701,11" And _  здесь дает ошибку
            arr(i1, 10).Value Like "*лип*" Then
            arr(i1, 4) = "Вход"
        End If
        
        If arr(i1, 29) = "701,2" Then
            arr(i1, 4) = "Вход"
        End If
    Next i1
    Range(sAddress).Value = arr
End Sub

@Alex77755 · 21.12.2012, 17:28

на какой строке? С Like? попробуй Instr

Добавлено через 57 минут
со списком замен(на листе "Замены" таблица:
Номер столбца Что искать Что вставлять

26	Алматы
16	алог	ДПП
16	ретьи	ДПП
21	Казкоммерцбан.Алматы	ДПП
20	Стандартный продукт - К	ДПП
20	Стандартный продукт - З	ДПП
21	Башеева	Глобал
21	Ерасилов	Глобал
21	Байзакова	Глобал
21	Джолдыбаева	Глобал
21	Катаева	Глобал
21	Буриева	Глобал
21	урахамед	Глобал
31		ДКС
11	- страхование на случай болезни	ДМС
11	- страхование от несчастных случаев	ДМС
29	701,11	DO
10	лип	Вход
29	701,2	Вход

Visual Basic

Sub ghrfh()
 Dim arr()  'объявили массив
 Dim Z(), C, j
 Dim t
 t = Time
Dim sAddress, iRowH, iRowE, iColumH, iColumE
 With Worksheets("Замены")
 Z = Range(.Cells(1, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 3))
 End With
    
    Worksheets("Отчет").Activate
    Columns(4).ClearContents
    sAddress = ActiveSheet.UsedRange.Address
    arr = Range(sAddress)
    iRowH = LBound(arr)
    iRowE = UBound(arr)
    iColumH = LBound(arr, 2)
    iColumE = UBound(arr, 2)
    
    For i1 = iRowH To iRowE
        If arr(i1, 30) = " " Then
            arr(i1, 30) = arr(i1, 28)
            arr(i1, 29) = arr(i1, 27)
        End If
    If InStr(1, arr(i1, 26), Z(1, 2)) > 0 Then
        For C = 1 To UBound(Z)
            If InStr(1, arr(i1, Z(C, 1)), Z(C, 2)) Then
                arr(i1, 4) = Z(C, 3): Exit For
            End If
        Next C
    Else
             arr(i1, 4) = arr(i1, 26)
    End If
        For C = 1 To UBound(Z)
            If Z(C, 2) <> "" Then
                If arr(i1, 29) = Z(C, 2) Then
                    Select Case Z(C, 3)
                    Case "DO"
                        For j = 1 To UBound(Z)
                            If InStr(1, arr(i1, 10), Z(j, 2)) > 0 Then
                                arr(i1, 4) = "Вход": Exit For
                            End If
                        Next j
                    Case Else
                         arr(i1, 4) = "Вход"
                    End Select
                End If
            End If
        Next C
    Next i1
   Range(sAddress).Value = arr
   MsgBox Format(Time - t, "nn:ss")
   
End Sub

@Hugo121 6922 / 2832 / 543 Регистрация: 19.10.2012 Сообщений: 8,645
	20.12.2012, 18:10	3
	Словарь с LIKE не дружит - придётся всё равно циклом перебирать. А вот всю эту кучу OR я бы заменил на select case true - так хоть не придётся проверять каждый раз все условия. Или вообще RegExp привлечь нужно. Ну и конечно всё нужно делать в массивах, а не на листе - я как-то мерил, массив в 47 раз был быстрее. На одном форуме давно удалось подобный код ускорить с 40 мин. до 5,5 сек - и это ещё без использования словаря (давно было, ещё не освоил никто... ) Добавлено через 2 минуты А все AND заменил на вложенные IF-THEN-END IF 0

@Alex77755 11508 / 3794 / 681 Регистрация: 13.02.2009 Сообщений: 11,197
	20.12.2012, 18:29	4
	То что словарь не дружит с Like, не может однозначно служить основанием отказа от него. Мы же не видим файла, не знаем формата записей. Разные бывают случаи. Возможно от Like можно(и нужно) будет отказаться 0

@scratganibal 0 / 0 / 0 Регистрация: 16.10.2012 Сообщений: 16
	21.12.2012, 07:51 [ТС]	7
	Прикрепляю исходник и желаемый результат (в последнем имеется и сам код) 0

@Hugo121 6922 / 2832 / 543 Регистрация: 19.10.2012 Сообщений: 8,645
	21.12.2012, 10:43	9
	Словарь тут точно можно использовать вместо поиска по Worksheets("Виды") - уже будет экономия. В общем, думаю тут тоже можно до 5 секунд сократить Хотя может и нет - сейчас импорт этих "$A$1:$AD$262323" уже занимает 2 секунды. 0

@scratganibal 0 / 0 / 0 Регистрация: 16.10.2012 Сообщений: 16
	21.12.2012, 11:02 [ТС]	10
	[QUOTE=Hugo121;3894020]Словарь тут точно можно использовать вместо поиска по Worksheets("Виды") - уже будет экономия. В общем, думаю тут тоже можно до 5 секунд сократить Хотя может и нет - сейчас импорт этих "$A$1:$AD$262323" уже занимает 2 секунды.[/ К сожалению я не имею пока представления об использовании словарей...., не подскажите как это сделать хотя бы на примере, с массивами тоже не сталкивался поскольку данные не были такими громадными для обработки, предыдущие пользовались фильтрами и сводными таблицами Excel, но опять же ручной труд перед "пишущей машинкой" хотелось бы конечно избежать практикуемого навыка. Сейчас перечитываю форум в поисках решения... пока учусь 0

@Hugo121 6922 / 2832 / 543 Регистрация: 19.10.2012 Сообщений: 8,645
	21.12.2012, 11:29	11
	У Вас массив уже используется при импорте данных Писать рабочий код на этом примере влом - слишком уж там всего много... Но я тут рядом давал пару кодов на словаре: Как создать массив массивов Смысл в чём - в начале кода из данных листа "Вид" заполняем словарь, затем когда нужно не ищем файндом на листе, а смотрим, есть ли такое в словаре. Быстро и код простой. 0

@Alex77755 11508 / 3794 / 681 Регистрация: 13.02.2009 Сообщений: 11,197
	21.12.2012, 16:03	14
	А что? вызывает ошибку что-то? Тип не объявлен - значит вариант - принимает любые значения 0