Как ускорить работу макроса по сбору данных с помощью регулярных выражений? / Visual Basic

ReSQL.ru

Мобильная версия Контакт Правила FAQ Помощь

Гость

Войти | Регистрация | Профиль | Очистить

Новые сообщения | Избранное

Форумы | Пользователи | Статистика | Мод. лог | Поиск

Цитировать

Написать

Автор*:

Ввести пароль для входа

Тема*:

Сообщение

Данное сообщение тематическое

Сообщение содержит картинки или видео 18+

Автор:

ВНИМАНИЕ! На данном подфоруме действуют строгие правила. Удостоверьтесь, что ваше сообщение соответствует им!

Форум или тема закрыты для гостей. Необходима авторизация!

Загрузить последнюю сохраненную версию

Вложение:

Вставить как галерею

Максимальный размер вложений: 4,0 МБ, аудио/видео: 8,0 МБ. Картинки большего размера ужимаются, если возможно.

Введите код, изображенный на картинке. Если код нечитаемый, кликните картинку, чтобы загрузить другой вариант.

Отправляя сообщение, я выражаю свое согласие с правилами форума и принимаю пользовательское соглашение.

Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр

Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

25 сообщений из 47, страница 1 из 2

все

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37164245

mimozka

Гость

Добрый вечер!
Помогите, пожалуйста, подскажите как можно ускорить работу моего макроса, как оптимизировать, очень долго работает.
В таблице с масками примерно 150 масок и таких таблиц 4, а данные, которые обрабатываю содержат в районе 80 000 строк.
Разбираю файл остатки на счете, и по маскам разбрасываю по группам приход/расход, суммируя итоговые суммы по маскам одной группы. этот кусок для прихода и подобный для расхода.

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.

For i =  2  To kol_maska 
    
    reDtF.Pattern = ThisWorkbook.Worksheets("маски_приход_Ф").Cells(i,  2 )
    reKtF.Pattern = ThisWorkbook.Worksheets("маски_приход_Ф").Cells(i,  3 )
    
    reDtF.IgnoreCase = True
    reDtF.Global = True
    reKtF.IgnoreCase = True
    reKtF.Global = True
    
    reDtGO.Pattern = ThisWorkbook.Worksheets("маски_приход_ГО").Cells(i,  2 )
    reKtGO.Pattern = ThisWorkbook.Worksheets("маски_приход_ГО").Cells(i,  3 )
    
    reDtGO.IgnoreCase = True
    reDtGO.Global = True
    reKtGO.IgnoreCase = True
    reKtGO.Global = True
    
    sumGO =  0 
    sumF =  0 
    For j =  1  To konec ' проверяем соответствие счетов маскам Приход 
    
        If ThisWorkbook.Worksheets("данные1").Cells(j,  5 ) <> "" And _
            ThisWorkbook.Worksheets("данные1").Cells(j,  4 ) = "" And _
            Mid(ThisWorkbook.Worksheets("данные1").Cells(j,  2 ),  10 ,  2 ) <> "00" And _
            reDtF.Test(ThisWorkbook.Worksheets("данные1").Cells(j,  2 ).Value) And _
            reKtF.Test(ThisWorkbook.Worksheets("данные1").Cells(j,  3 ).Value) Then
 
          sumF = sumF + CDbl(ThisWorkbook.Worksheets("данные1").Cells(j,  4 ).Value)
         
         ElseIf ThisWorkbook.Worksheets("данные1").Cells(j,  5 ) <> "" And _
            ThisWorkbook.Worksheets("данные1").Cells(j,  4 ) = "" And _
            Mid(ThisWorkbook.Worksheets("данные1").Cells(j,  2 ),  10 ,  2 ) = "00" And _
            reDtGO.Test(ThisWorkbook.Worksheets("данные1").Cells(j,  2 ).Value) And _
            reKtGO.Test(ThisWorkbook.Worksheets("данные1").Cells(j,  3 ).Value) Then
          
          sumGO = sumGO + CDbl(ThisWorkbook.Worksheets("данные1").Cells(j,  4 ).Value)
         
        End If
    Next j
    
    q =  2 
    If sumF <>  0  Or sumGO <>  0  Then
     While ThisWorkbook.Worksheets("Свод").Cells(q,  2 ) <> ""
        
        If ThisWorkbook.Worksheets("Свод").Cells(q,  1 ) = ThisWorkbook.Worksheets("маски_приход_Ф").Cells(i,  5 ) And _
            ThisWorkbook.Worksheets("Свод").Cells(q,  2 ) = ThisWorkbook.Worksheets("маски_приход_Ф").Cells(i,  1 ) Then
           
               ThisWorkbook.Worksheets("Свод").Cells(q,  4 ) = CDbl(ThisWorkbook.Worksheets("Свод").Cells(q,  4 ).Value) + sumF
          
        ElseIf ThisWorkbook.Worksheets("Свод").Cells(q,  1 ) = ThisWorkbook.Worksheets("маски_приход_ГО").Cells(i,  5 ) And _
            ThisWorkbook.Worksheets("Свод").Cells(q,  2 ) = ThisWorkbook.Worksheets("маски_приход_ГО").Cells(i,  1 ) Then
           
               ThisWorkbook.Worksheets("Свод").Cells(q,  4 ) = CDbl(ThisWorkbook.Worksheets("Свод").Cells(q,  4 ).Value) + sumGO
        
        End If
        q = q +  1 
     Wend
    End If
Next i

...

Рейтинг:

0 / 0

14.03.2011, 17:05

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37164305

Игорь Горбонос

Участник

Откуда: Днепропетровск

Сообщения: 4 416

Рейтинг: 0 / 0

> Автор: mimozka

А кто такие reDtF и иже с ними?
Начни с того, что замени все такие записи ThisWorkbook.Worksheets("маски_приход_ГО") на переменные типа Worksheet и
испульзуй With.
И используй тэг [ S R C ]

Posted via ActualForum NNTP Server 1.4

...

Рейтинг:

0 / 0

14.03.2011, 17:26

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37164471

mds_world

Участник

Откуда: Ташкент

Сообщения: 27 530

Рейтинг: 0 / 0

mimozkaподскажите как можно ускорить работу моего макроса, как оптимизировать, очень долго работает.
В таблице с масками примерно 150 масок и таких таблиц 4, а данные, которые обрабатываю содержат в районе 80 000 строк.
Разбираю файл остатки на счете, и по маскам разбрасываю по группам приход/расход, суммируя итоговые суммы по маскам одной группы. этот кусок для прихода и подобный для расхода.
В любой БД, закачав в нее таблицу екселя, желаемый результат можно получить запросом во вполне допустимое время.

...

Рейтинг:

0 / 0

14.03.2011, 18:57

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37164707

пробуй камнем

Гость

mimozka,
первый цикл оптимизируется доволно просто - нужно его закомментировать. Заодно и от ошибки 'Type mismatch' при попытке конвертировать пустую строку в Double избавитесь.

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.

    For j =  1  To konec ' проверяем соответствие счетов маскам Приход 
    
        If ThisWorkbook.Worksheets("данные1").Cells(j,  5 ) <> "" And _
            ThisWorkbook.Worksheets("данные1").Cells(j,  4 ) = "" And _
            Mid(ThisWorkbook.Worksheets("данные1").Cells(j,  2 ),  10 ,  2 ) <> "00" And _
            reDtF.Test(ThisWorkbook.Worksheets("данные1").Cells(j,  2 ).Value) And _
            reKtF.Test(ThisWorkbook.Worksheets("данные1").Cells(j,  3 ).Value) Then
 
          sumF = sumF + CDbl(ThisWorkbook.Worksheets("данные1").Cells(j,  4 ).Value)
         
         ElseIf ThisWorkbook.Worksheets("данные1").Cells(j,  5 ) <> "" And _
            ThisWorkbook.Worksheets("данные1").Cells(j,  4 ) = "" And _
            Mid(ThisWorkbook.Worksheets("данные1").Cells(j,  2 ),  10 ,  2 ) = "00" And _
            reDtGO.Test(ThisWorkbook.Worksheets("данные1").Cells(j,  2 ).Value) And _
            reKtGO.Test(ThisWorkbook.Worksheets("данные1").Cells(j,  3 ).Value) Then
          
          sumGO = sumGO + CDbl(ThisWorkbook.Worksheets("данные1").Cells(j,  4 ).Value)
         
        End If
    Next j

...

Рейтинг:

0 / 0

14.03.2011, 23:33

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37164729

пробуй камнем

Гость

mimozka,
принимая во внимание предидущий шаг, приходим к выводу, что цикл While ....Wend в цепких объятьях If ... Then ... End If никогда не будет выполняться:

Код: plaintext

1.
2.
3.
4.
5.

    If sumF <>  0  Or sumGO <>  0  Then ' sumF==0 и sumGO==0
     While ' {skipped}
' {skipped}
     Wend
    End If

Учитывая всё вышеизложенное, получаем оптимизированный "цикл":

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.

With ThisWorkbook.Worksheets("маски_приход_Ф")
    reDtF.Pattern = .Cells(kol_maska,  2 )
    reKtF.Pattern = .Cells(kol_maska,  3 )
End With
    reDtF.IgnoreCase = True
    reDtF.Global = True
    reKtF.IgnoreCase = True
    reKtF.Global = True
With ThisWorkbook.Worksheets("маски_приход_ГО")    
    reDtGO.Pattern = .Cells(kol_maska,  2 )
    reKtGO.Pattern = .Cells(kol_maska,  3 )
End With    
    reDtGO.IgnoreCase = True
    reDtGO.Global = True
    reKtGO.IgnoreCase = True
    reKtGO.Global = True
    
    sumGO =  0 
    sumF =  0 

    q =  2

2 All: поправьте, если ошибся.

...

Рейтинг:

0 / 0

14.03.2011, 23:50

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37165091

mimozka

Гость

Игорь Горбонос> Автор: mimozka

А кто такие reDtF и иже с ними?

Dim reDtF As New regexp - это регулярное выражение

p.s. Всем отписавшимся Спасибо!!! в течении дня опробую, потом отпишусь. Спасибо! :)

...

Рейтинг:

0 / 0

15.03.2011, 10:43

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37165244

mimozka

Гость

пробуй камнемmimozka,
первый цикл оптимизируется доволно просто - нужно его закомментировать. Заодно и от ошибки 'Type mismatch' при попытке конвертировать пустую строку в Double избавитесь.

не поправила из куска Расход, т.е. ячейка должна быть Cells(j, 5) -кредитовый оборот, ошибки не будет.
sumF = sumF + CDbl(ThisWorkbook.Worksheets("данные1").Cells(j, 5).Value),
как так просто закомментировать?

...

Рейтинг:

0 / 0

15.03.2011, 11:40

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37165713

The_Prist

Участник

Откуда: www.excel-vba.ru

Сообщения: 2 025

Рейтинг: 0 / 0

Кстати, все эти бесконечные And надо тоже убрать и заменить их отдельными конструкциями If ... End If

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.

    With ThisWorkbook.Worksheets("данные1")
        If .Cells(j,  5 ) <> "" Then
            If .Cells(j,  4 ) = "" Then
                If reDtF.Test(.Cells(j,  2 ).Value) Then
                    If reKtF.Test(.Cells(j,  3 ).Value) Then
                        If Mid$(.Cells(j,  2 ),  10 ,  2 ) <> "00" Then
                            sumF = sumF + CDbl(.Cells(j,  4 ).Value)
                        Else
                            sumGO = sumGO + CDbl(.Cells(j,  4 ).Value)
                        End If
                    End If
                End If
            End If
        End If
    End With

К тому же у Вас повторяются проверки значений - это тоже отнимает время. Сократил код до разумного. А еще можно все это в массиве обрабатывать - вообще быстро будет.

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.

    sumGO =  0 
    sumF =  0 
    Dim avArr, j As Long
    With ThisWorkbook.Worksheets("данные1")
        avArr = Range(.Cells( 1 ,  1 ), .Cells(konec,  5 )).Value
        For j =  1  To konec    ' проверяем соответствие счетов маскам Приход
            If avArr(j,  5 ) <> "" Then
                If avArr(j,  4 ) = "" Then
                    If reDtF.Test(avArr(j,  2 )) Then
                        If reKtF.Test(avArr(j,  3 )) Then
                            If Mid$(avArr(j,  2 ),  10 ,  2 ) <> "00" Then
                                sumF = sumF + CDbl(avArr(j,  4 ))
                            Else
                                sumGO = sumGO + CDbl(avArr(j,  4 ))
                            End If
                        End If
                    End If
                End If
            End If
        Next j
    End With

...

Рейтинг:

0 / 0

15.03.2011, 14:10

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37165738

The_Prist

Участник

Откуда: www.excel-vba.ru

Сообщения: 2 025

Рейтинг: 0 / 0

Хотя я упустил один момент, про который уже упоминали - Вы в любом случае хотите преобразовать в число пустую строку.

Код: plaintext

ThisWorkbook.Worksheets("данные1").Cells(j,  4 ) = ""
sumF = sumF + CDbl(ThisWorkbook.Worksheets("данные1").Cells(j,  4 ).Value)

Это как-то неправильно...Вот так, наверное:

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.

    sumGO =  0 
    sumF =  0 
    Dim avArr, j As Long
    With ThisWorkbook.Worksheets("данные1")
        avArr = Range(.Cells( 1 ,  1 ), .Cells(konec,  5 )).Value
        For j =  1  To konec    ' проверяем соответствие счетов маскам Приход
            If avArr(j,  5 ) <> "" Then
                If avArr(j,  4 ) <> "" Then
                    If IsNumeric(avArr(j,  4 )) Then'проверяем - числовое значение в ячейке или нет.
                        If reDtF.Test(avArr(j,  2 )) Then
                            If reKtF.Test(avArr(j,  3 )) Then
                                If Mid$(avArr(j,  2 ),  10 ,  2 ) <> "00" Then
                                    sumF = sumF + CDbl(avArr(j,  4 ))
                                Else
                                    sumGO = sumGO + CDbl(avArr(j,  4 ))
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        Next j
    End With

А еще лучше, наверное так:

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.

    sumGO =  0 
    sumF =  0 
    Dim avArr, j As Long
    With ThisWorkbook.Worksheets("данные1")
        avArr = Range(.Cells( 1 ,  1 ), .Cells(konec,  5 )).Value
        For j =  1  To konec    ' проверяем соответствие счетов маскам Приход
            If avArr(j,  5 ) <> "" Then
                If avArr(j,  4 ) <> "" Then
                    If reDtF.Test(avArr(j,  2 )) Then
                        If reKtF.Test(avArr(j,  3 )) Then
                            If Mid$(avArr(j,  2 ),  10 ,  2 ) <> "00" Then
                                sumF = sumF + Val(Replace(avArr(j,  4 ), ",", ".")) 'сразу число прибавляем
                            Else
                                sumGO = sumGO + Val(Replace(avArr(j,  4 ), ",", "."))
                            End If
                        End If
                    End If
                End If
            End If
        Next j
    End With

...

Рейтинг:

0 / 0

15.03.2011, 14:17

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37165880

mimozka

Гость

The_PristХотя я упустил один момент, про который уже упоминали - Вы в любом случае хотите преобразовать в число пустую строку.
Я же написала перед Вашими сообщениями, что не (j, 4), а (j, 5), т.е. я проверяю, что (j, 5) не пуст, а (j, 4) пуст и преобразую (j, 5) в CDbl.
(j, 4) -Дебет
(j, 5) -Кредит, т.е. я смотрю кредитовый оборот в выписке.

...

Рейтинг:

0 / 0

15.03.2011, 14:59

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37165891

The_Prist

Участник

Откуда: www.excel-vba.ru

Сообщения: 2 025

Рейтинг: 0 / 0

mimozka,

Так ведь еще проце:

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.

    sumGO =  0 
    sumF =  0 
    Dim avArr, j As Long
    With ThisWorkbook.Worksheets("данные1")
        avArr = Range(.Cells( 1 ,  1 ), .Cells(konec,  5 )).Value
        For j =  1  To konec    ' проверяем соответствие счетов маскам Приход
            If reDtF.test(avArr(j,  2 )) Then
                If reKtF.test(avArr(j,  3 )) Then
                    If Mid$(avArr(j,  2 ),  10 ,  2 ) <> "00" Then
                        sumF = sumF + Val(Replace(avArr(j,  4 ), ",", "."))    'сразу число прибавляем
                    Else
                        sumGO = sumGO + Val(Replace(avArr(j,  5 ), ",", "."))'Это расходи или приход? В общем замените сами где нужно 4 на 5.
                    End If
                End If
            End If
        Next j
    End With

Я сообщение читал, но не очень понял, что Вы там где забыли заменить, т.к. кусок Расход не очень-то в глаза бросается. Приход есть - а Расход не видать :-)

...

Рейтинг:

0 / 0

15.03.2011, 15:03

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37165922

mimozka

Гость

К тому же у Вас повторяются проверки значений - это тоже отнимает время.
Да, но теперь пропала проверка по DtGO и KtGO, у меня 2 таблицы масок для прихода: дебет, кредит для филиалов и дебет, кредит для головы.

...

Рейтинг:

0 / 0

15.03.2011, 15:14

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37165948

mimozka

Гость

The_PristЯ сообщение читал, но не очень понял, что Вы там где забыли заменить, т.к. кусок Расход не очень-то в глаза бросается. Приход есть - а Расход не видать :-)
А Расхода и нет :), я его не выставляла, он есть у меня, он подобный приходу, который я делала копипастом и не поправила.

...

Рейтинг:

0 / 0

15.03.2011, 15:24

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37165956

The_Prist

Участник

Откуда: www.excel-vba.ru

Сообщения: 2 025

Рейтинг: 0 / 0

Ну да...Действительно. Может так?

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.

    sumGO =  0 
    sumF =  0 
    Dim avArr, j As Long
    With ThisWorkbook.Worksheets("данные1")
        avArr = Range(.Cells( 1 ,  1 ), .Cells(konec,  5 )).Value
        For j =  1  To konec    ' проверяем соответствие счетов маскам Приход
            If Mid$(avArr(j,  2 ),  10 ,  2 ) <> "00" Then
                If reKtF.test(avArr(j,  3 )) And reDtF.test(avArr(j,  2 )) Then
                    sumF = sumF + Val(Replace(avArr(j,  4 ), ",", "."))    'сразу число прибавляем
                End If
            Else
                If reDtGO.test(avArr(j,  2 )) And reKtGO.test(avArr(j,  3 )) Then
                    sumGO = sumGO + Val(Replace(avArr(j,  4 ), ",", "."))
                End If
            End If
        Next j
    End With

...

Рейтинг:

0 / 0

15.03.2011, 15:28

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37165988

mimozka

Гость

The_Prist,
но это не весь Расход, который у меня был, так?
потому как если сумму обнулять в самом начале, а потом идти по всем маскам, то у меня в итоге будет всего 2 суммы sumGO и sumF, а в моем случае надо еще разбивать по группам, т.е. допустим 5 масок это 1-я группа, 4 маски-2 группа и т .д. и суммы по каждой группе должны быть в своей ячейке итоговой таблицы.

...

Рейтинг:

0 / 0

15.03.2011, 15:45

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37166029

пробуй камнем

Гость

mimozka,
заинтриговали.
Маски действительно настолько сложные, что требуются регуляярные выражения? Может быдет достаточно LIKE ?

...

Рейтинг:

0 / 0

15.03.2011, 16:05

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37166082

The_Prist

Участник

Откуда: www.excel-vba.ru

Сообщения: 2 025

Рейтинг: 0 / 0

mimozka,

если честно, то с файлом было бы проще разобраться, нежели с НЕПОЛНЫМ вашим кодом.
Вот что-то такое получилось - но проверить не на чем.

Код: plaintext

    Dim avArr, j As Long, avМаски_приход_ГО_Arr, avМаски_приход_Ф_Arr, i As Long
    Dim avSvodArr
    With ThisWorkbook
        With .Worksheets("маски_приход_ГО")
            avМаски_приход_ГО_Arr = Range(.Cells( 1 ,  1 ), .Cells(kol_maska,  5 )).Value
        End With
        With .Worksheets("маски_приход_Ф")
            avМаски_приход_Ф_Arr = Range(.Cells( 1 ,  1 ), .Cells(kol_maska,  5 )).Value
        End With
        With .Worksheets("данные1")
            avArr = Range(.Cells( 1 ,  1 ), .Cells(konec,  5 )).Value
        End With

        With .Worksheets("Свод")
            lENDSvod = .Cells(.Rows.Count,  2 ).End(xlUp).Row
            avSvodArr = Range(.Cells( 1 ,  1 ), .Cells(lENDSvod,  5 )).Value
        End With

        For i =  2  To kol_maska
            reDtF.Pattern = avМаски_приход_ГО_Arr(i,  2 ): reDtF.IgnoreCase = True: reDtF.Global = True
            reKtF.Pattern = avМаски_приход_ГО_Arr(i,  3 ): reKtF.IgnoreCase = True: reKtF.Global = True

            reDtGO.Pattern = avМаски_приход_ГО_Arr(i,  2 ): reDtGO.IgnoreCase = True: reDtGO.Global = True
            reKtGO.Pattern = avМаски_приход_ГО_Arr(i,  3 ): reKtGO.IgnoreCase = True: reKtGO.Global = True

            sumGO =  0 : sumF =  0 

            For j =  1  To konec    ' проверяем соответствие счетов маскам Приход
                If Mid$(avArr(j,  2 ),  10 ,  2 ) <> "00" Then
                    If reKtF.test(avArr(j,  3 )) And reDtF.test(avArr(j,  2 )) Then
                        sumF = sumF + Val(Replace(avArr(j,  4 ), ",", "."))    'сразу число прибавляем
                    End If
                Else
                    If reDtGO.test(avArr(j,  2 )) And reKtGO.test(avArr(j,  3 )) Then
                        sumGO = sumGO + Val(Replace(avArr(j,  4 ), ",", "."))
                    End If
                End If
            Next j

            If (sumF + sumGO) <>  0  Then
                With .Worksheets("Свод")
                    For q =  2  To lENDSvod
                        If avSvodArr(q,  1 ) = avМаски_приход_Ф_Arr(i,  5 ) And _
                           avSvodArr(q,  2 ) = avМаски_приход_Ф_Arr(i,  1 ) Then
                            .Cells(q,  4 ) = Val(Replace(avSvodArr(q,  4 ), ",", ".")) + sumF

                        ElseIf avSvodArr(q,  1 ) = avМаски_приход_ГО_Arr(i,  5 ) And _
                               avSvodArr(q,  2 ) = avМаски_приход_ГО_Arr(i,  1 ) Then
                            .Cells(q,  4 ) = Val(Replace(avSvodArr(q,  4 ), ",", ".")) + sumGO
                        End If
                    Next q
                End With
            End If
        Next i
    End With

...

Рейтинг:

0 / 0

15.03.2011, 16:22

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37166123

mimozka

Гость

пробуй камнемmimozka,
заинтриговали.
Маски действительно настолько сложные, что требуются регуляярные выражения? Может быдет достаточно LIKE ?
например 47423810[0-9]{3}02[0-9]{7} или [0156789][12345689][01356789][13456789][02345689][0-9]{15} :)

...

Рейтинг:

0 / 0

15.03.2011, 16:34

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37166145

пробуй камнем

Гость

mimozka,
убедили.

2 The_Prist :

Код: plaintext

1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.

' {skipped}
                    For q =  2  To lENDSvod
                        If avSvodArr(q,  1 ) = avМаски_приход_Ф_Arr(i,  5 ) And _
                           avSvodArr(q,  2 ) = avМаски_приход_Ф_Arr(i,  1 ) Then
                            .Cells(q,  4 ) = Val(Replace(avSvodArr(q,  4 ), ",", ".")) + sumF

                        ElseIf avSvodArr(q,  1 ) = avМаски_приход_ГО_Arr(i,  5 ) And _
                               avSvodArr(q,  2 ) = avМаски_приход_ГО_Arr(i,  1 ) Then
                            .Cells(q,  4 ) = Val(Replace(avSvodArr(q,  4 ), ",", ".")) + sumGO
                        End If
                    Next q
' {skipped}
' выделенное выбивается из общего стиля "работу с листами вынести за цикл"

...

Рейтинг:

0 / 0

15.03.2011, 16:42

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37166156

The_Prist

Участник

Откуда: www.excel-vba.ru

Сообщения: 2 025

Рейтинг: 0 / 0

пробуй камнем,

Без примера данных или полного кода трудно это обойти. Т.к. надо в массив загонять сами значения и затем на лист выгружать. А для этого надо хотя бы видеть куда . Поэтому эти две строки и остались такими, ибо по другому значения на лист по вышеуказанным причинам не внести.

...

Рейтинг:

0 / 0

15.03.2011, 16:45

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37166263

mimozka

Гость

The_Prist,
лист "Данные1"

бик дт кт № п/п
028200003 42305081000000030000 40101810100000010001 500.00 65537
028200001 41506081000000000000 40101810100000010001 500.00 65538
и т.д.

лист "маски_приход_ГО"

группа маска по ДТ маска по КТ наименование
1 [0-9]{20} 473[0-9]{17} Возврат кредитов
7 [0-9]{20} 47407810[0-9]{3}34[0-9]{7} Банковские конвертации

лист "Свод"
Группа Наименование группы (статья прихода) Сумма
приход 1 Возврат кредитов
приход 2 Возврат выданных МБК

...

Рейтинг:

0 / 0

15.03.2011, 17:33

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37166273

mimozka

Гость

РјР»РёРЅ, РЅР°РёРјРµРЅРѕРІР°РЅРёСЏ СЃС‚РѕР»Р±С†РѕРІ СЃСЉРµС…Р°Р»Рё (

...

Рейтинг:

0 / 0

15.03.2011, 17:39

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37166276

mimozka

Гость

млин, наименования столбцов съехали ((

...

Рейтинг:

0 / 0

15.03.2011, 17:40

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37166281

The_Prist

Участник

Откуда: www.excel-vba.ru

Сообщения: 2 025

Рейтинг: 0 / 0

mimozka028200003 42305081000000030000 40101810100000010001 500.00 65537
028200001 41506081000000000000 40101810100000010001 500.00 65538Если 500.00 это сумма, и все суммы у Вас записаны с разделителем дробной части точка, то эти строки:

Код: plaintext

.Cells(q,  4 ) = Val(Replace(avSvodArr(q,  4 ), ",", ".")) + sumGO

можно записать так:

Код: plaintext

.Cells(q,  4 ) = Val(avSvodArr(q,  4 )) + sumGO

А вообще под примером я имел ввиду файл Excel , а не строки, из него скопированные.

...

Рейтинг:

0 / 0

15.03.2011, 17:44

| Ответить | Цитировать | Написать

Как ускорить работу макроса по сбору данных с помощью регулярных выражений?

#37166312

пробуй камнем

Гость

2 The_PristThe_Pristпробуй камнем,
...
Т.к. надо в массив загонять сами значения и затем на лист выгружать. А для этого надо хотя бы видеть куда . ...
Откуда:
The_Prist

Код: plaintext

1.
2.
3.
4.
5.
6.

' {skipped}
        With .Worksheets("Свод")
            lENDSvod = .Cells(.Rows.Count,  2 ).End(xlUp).Row
            avSvodArr = Range(.Cells( 1 ,  1 ), .Cells(lENDSvod,  5 )).Value
        End With
' {skipped}

Куда: - туда же, откуда читали в массив.

2 mimozka,
можно оптимизировать при условии, что маски не пересекаются, т.е.
если значение данные1.Cells(j, 2)
совпало с маской маски_приход_Ф.Cells(1, 2) ,
то ни с какими другими масками оно не совпадёт.
В этом случае соответствия маске, у значения выставляется флаг "уже распределили". При проходе со следующими масками, если флаг "уже распределили" установлен, то значение не тестируется на соответствие маске.

...

Рейтинг:

0 / 0

15.03.2011, 18:05

| Ответить | Цитировать | Написать

25 сообщений из 47, страница 1 из 2

все

Читали тему (0):

Читали форум (0):

Пользователи онлайн (0):

start [/forum/topic.php?fid=60&fpage=103&tid=2158780]:	0ms
get settings:	9ms
get forum list:	11ms
check forum access:	4ms
check topic access:	4ms
track hit:	28ms
get topic data:	10ms
get forum data:	2ms
get page messages:	59ms
get tp. blocked users:	2ms
others:	10ms

total:	139ms