VBA который обрабатывает данные в памяти Excel

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » VBA который обрабатывает данные в памяти Excel (Макросы/Sub)

IvanK710

Дата: Понедельник, 05.03.2018, 16:35 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 22

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Уважаемые гуру VBA!

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

Вводные данные:
Имеется файл с кучей закладок (около 800)
На каждой из закладок есть несколько колонок с формулами. Как понимаете, при обновлеии файла, калькуляция занимает до 20 минут что очень долго... Знаю, что данные можно закинуть в память эксель и произвести все расчеты там. А на листы уже вписать значения без формул. Но знаний не хватает сделать это.. Кто может помочь?

Приаттачил файл, но оставил там только несколько закладок, чтобы было попроще работать с файлом :-)
Заранее спасибо за помощь и подсказки!

Ответить

sboy

Дата: Понедельник, 05.03.2018, 16:39 | Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 2566

Репутация: 724 ±

Замечаний: 0% ±

Excel 2010

Цитата IvanK710, 05.03.2018 в 16:35, в сообщении № 1 ()

Приаттачил файл

не пролез) ограничение на объем файла 100кб

Яндекс: 410016850021169

Ответить

IvanK710

Дата: Понедельник, 05.03.2018, 16:47 | Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 22

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

ага, пришлось подчистить )))

Приаттачил.

К сообщению приложен файл: superfile.xls (92.5 Kb)

Ответить

IvanK710

Дата: Вторник, 06.03.2018, 13:23 | Сообщение № 4

Группа: Пользователи

Ранг: Новичок

Сообщений: 22

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Добавил в файл вот этот код, который закидывает данные в память. Подскажите, все правильно? Как мне теперь вытащить из него необходимые данные? :-)

[vba]

Код

Sub Test001()

Dim B As New Collection
LastRow = Range("A2").End(xlDown).Row 'last colomun calculation
For i = 3 To LastRow
Dim A As New Data1
A.Number = Sheet_Data1.Range("A2")
A.Date_ = Sheet_Data1.Range("C2")
A.Parametr = Sheet_Data1.Range("B2")
A.Quantity = Sheet_Data1.Range("D2")
B.Add A
Set A = Nothing
Next i
i = 1

End Sub

[/vba]

К сообщению приложен файл: 8884854.xls (95.0 Kb)

Сообщение отредактировал IvanK710 - Вторник, 06.03.2018, 13:24

Ответить

SLAVICK

Дата: Вторник, 06.03.2018, 15:37 | Сообщение № 5

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация: 766 ±

Замечаний: 0% ±

2019

Цитата IvanK710, 06.03.2018 в 13:23, в сообщении № 4 ()

все правильно? Как мне теперь вытащить из него необходимые данные?

Зачем так усложнять?
можно просто так сделать:
[vba]

Код

Sub D()
Dim lastrow&, arr
lastrow = Range("A2").End(xlDown).Row 'last colomun calculation

'Добавляем Массив в "память"
arr = Range("A2:d" & lastrow)

'Достаем из "памяти" на лист
Range("e2").Resize(UBound(arr), UBound(arr, 2)) = arr

End Sub

[/vba]

Иногда все проще чем кажется с первого взгляда.

Ответить

IvanK710

Дата: Вторник, 06.03.2018, 16:28 | Сообщение № 6

Группа: Пользователи

Ранг: Новичок

Сообщений: 22

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

SLAVICK, спасибо!
Но задача в том, чтобы загнать данные с листа в массив и потом произвести расчеты и вытянуть все на другие листы

1111

Код

=MIN(IF(Data1!$A$1:$A$51=A1,Data1!$C$1:$C$51))
                =SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A3,Data1!B:B,"Sec")+SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A3,Data1!B:B,"Min")
=A3+1    =SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A4,Data1!B:B,"Sec")+SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A4,Data1!B:B,"Min")
=A4+1    =SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A5,Data1!B:B,"Sec")+SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A5,Data1!B:B,"Min")
=A5+1    =SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A6,Data1!B:B,"Sec")+SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A6,Data1!B:B,"Min")
=A6+1    =SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A7,Data1!B:B,"Sec")+SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A7,Data1!B:B,"Min")
=A7+1    =SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A8,Data1!B:B,"Sec")+SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A8,Data1!B:B,"Min")
=A8+1    =SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A9,Data1!B:B,"Sec")+SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A9,Data1!B:B,"Min")
=A9+1    =SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A10,Data1!B:B,"Sec")+SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A10,Data1!B:B,"Min")
=A10+1    =SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A11,Data1!B:B,"Sec")+SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A11,Data1!B:B,"Min")
=A11+1    =SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A12,Data1!B:B,"Sec")+SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A12,Data1!B:B,"Min")
=A12+1    =SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A13,Data1!B:B,"Sec")+SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A13,Data1!B:B,"Min")
=A13+1    =SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A14,Data1!B:B,"Sec")+SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A14,Data1!B:B,"Min")
=A14+1    =SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A15,Data1!B:B,"Sec")+SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A15,Data1!B:B,"Min")
=A15+1    =SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A16,Data1!B:B,"Sec")+SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A16,Data1!B:B,"Min")

Ответить

IvanK710

Дата: Вторник, 06.03.2018, 16:43 | Сообщение № 7

Группа: Пользователи

Ранг: Новичок

Сообщений: 22

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

немного упрощу и перефразирую задачу - мне нужно загнать один лист (Data1) в массив и вставить на лист значение вот этой формулы:

Код

=МИН(ЕСЛИ(Data1!$A$1:$A$51=A1;Data1!$C$1:$C$51))

Сообщение отредактировал IvanK710 - Вторник, 06.03.2018, 16:44

Ответить

SLAVICK

Дата: Вторник, 06.03.2018, 17:28 | Сообщение № 8

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация: 766 ±

Замечаний: 0% ±

2019

Цитата IvanK710, 06.03.2018 в 16:43, в сообщении № 7 ()

и вставить на лист значение вот этой формулы:

[vba]

Код

Sub D()
Dim lastrow&, arr, dic As Object, i&, t#, arrN

Set dic = CreateObject("Scripting.dictionary")

lastrow = Range("A2").End(xlDown).Row 'last colomun calculation
'Добавляем Массив в "память"
arr = Range("A2:d" & lastrow)

'Просчет минимумов
For i = 1 To UBound(arr)
    If dic.exists(arr(i, 1)) Then t = dic(arr(i, 1)) Else t = 9 ^ 9
    dic(arr(i, 1)) = Application.WorksheetFunction.Min(t, arr(i, 3))
Next

'Заполнение итогового массива
ReDim arrN(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
    arrN(i, 1) = dic(arr(i, 1))
Next
'Достаем из "памяти" на лист
Range("f2").Resize(UBound(arrN)) = arrN

End Sub

[/vba]

К сообщению приложен файл: 8884854.xlsm (44.9 Kb)

Иногда все проще чем кажется с первого взгляда.

Ответить

IvanK710

Дата: Вторник, 06.03.2018, 17:56 | Сообщение № 9

Группа: Пользователи

Ранг: Новичок

Сообщений: 22

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

SLAVICK,

Большое спасибо за код, работает!

Можно еще попросить Вас вытащить вот эти данные (формула) из масива и вставить в лист "5555" начиная с B3?

Код

=SUMIFS(Data1!D:D,Data1!A:A,$A$1,Data1!C:C,A3,Data1!B:B,"Min")

Заранее ОГРОМНОЕ СПАСИБО!!!

Ответить

SLAVICK

Дата: Среда, 07.03.2018, 10:42 | Сообщение № 10

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация: 766 ±

Замечаний: 0% ±

2019

Ваша вторая формула - в корни отличается от первой.
В Вашем случае - легче использовать Evaluate - он позволяет делать расчеты разными формулами внутри макроса:
[vba]

Код

Sub DD()
Dim lastrow&, arr, i&, arrN
With Sheets("5555")
    lastrow = .Range("A2").End(xlDown).Row 'last colomun calculation
    'Добавляем Массив в "память"
    arr = .Range("A3:d" & lastrow)
    'Заполнение итогового массива
    ReDim arrN(1 To UBound(arr), 1 To 1)
    For i = 1 To UBound(arr)
        arrN(i, 1) = Evaluate("=SUMIFS(Data1!D:D,Data1!A:A," & .[a1] & ",Data1!C:C," & CDbl(arr(i, 1)) & ",Data1!B:B,""Min"")")
    Next
    .Range("f3").Resize(UBound(arrN)) = arrN
End With
End Sub

[/vba]
Остальные формулы - сами старайтесь подогнать.
Обратите внимание на этот кусок:
[vba]

Код

CDbl(arr(i, 1)) '- перевод дат в число

[/vba]

Добавлено
Упустил из вида, что загвоздка в скорости.
Ладно, поскольку уже сам ответил - сделал на массивах (см. файл 2):
[vba]

Код

Sub Ddd()
Dim lastrow&, arr, Marr, dic As Object, i&, t#, arrN

Set dic = CreateObject("Scripting.dictionary")

With Sheets("Data1")
    lastrow = .Range("A2").End(xlDown).Row 'last colomun calculation
    'Добавляем Массив в "память"
    arr = .Range("A2:d" & lastrow)
End With

'Просчет Суммы
For i = 1 To UBound(arr)
    If dic.exists(arr(i, 1) & arr(i, 2) & arr(i, 3)) Then
        dic(arr(i, 1) & arr(i, 2) & arr(i, 3)) = dic(arr(i, 1) & arr(i, 2) & arr(i, 3)) + arr(i, 4)
    Else
        dic(arr(i, 1) & arr(i, 2) & arr(i, 3)) = arr(i, 4)
    End If
    If i \ 100 = i / 100 Then DoEvents: Application.StatusBar = "Calculate sum: " & i & ": " & Format(i / UBound(arr), "0%")
Next

'Заполнение итогового массива
With Sheets("5555")
    lastrow = .Range("A2").End(xlDown).Row 'last colomun calculation
    'Добавляем Массив в "память"
    arr = .Range("A3:d" & lastrow)
    'Заполнение итогового массива
    ReDim arrN(1 To UBound(arr), 1 To 1)
    For i = 1 To UBound(arr)
        If dic.exists(.[a1] & "Min" & arr(i, 1)) Then arrN(i, 1) = dic(.[a1] & "Min" & arr(i, 1))
        If i \ 100 = i / 100 Then DoEvents: Application.StatusBar = "Calculate FinArray: " & i & ": " & Format(i / UBound(arr), "0%")
    Next
    .Range("e3").Resize(UBound(arrN)) = arrN
End With

Application.StatusBar = False
End Sub

[/vba]
Но все Ваши остальные формулы или сами переводите, или отдельными темами, с указанием формулы хотите перевести в массивы...

Код

[/vba]
Остальные формулы - сами старайтесь подогнать.
Обратите внимание на этот кусок:
[vba]

Код

CDbl(arr(i, 1)) '- перевод дат в число

Код

[/vba]
Но все Ваши остальные формулы или сами переводите, или отдельными темами, с указанием формулы хотите перевести в массивы...SLAVICK

К сообщению приложен файл: 8884854-2-.xlsm (49.8 Kb) · 8884854-2-2018-.xlsm (53.1 Kb)

Иногда все проще чем кажется с первого взгляда.

Ответить

СообщениеВаша вторая формула - в корни отличается от первой.
В Вашем случае - легче использовать Evaluate - он позволяет делать расчеты разными формулами внутри макроса:
[vba]

Код

[/vba]
Остальные формулы - сами старайтесь подогнать.
Обратите внимание на этот кусок:
[vba]

Код

CDbl(arr(i, 1)) '- перевод дат в число

Код

Автор - SLAVICK
Дата добавления - 07.03.2018 в 10:42

IvanK710

Дата: Среда, 07.03.2018, 12:32 | Сообщение № 11

Группа: Пользователи

Ранг: Новичок

Сообщений: 22

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

SLAVICK, спасибо Вам огромное за помощь! Вы мне очень помогли (как и многим на этом форуме, судя по репутации в профиле), сейчас буду применять Ваш код на большом файле, отпишусь о результатах.

Сообщение отредактировал IvanK710 - Среда, 07.03.2018, 12:33

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » VBA который обрабатывает данные в памяти Excel (Макросы/Sub)

Страница 1 из 1
1