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

Вход

Регистрация

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

 

= Мир MS Excel/VBA который обрабатывает данные в памяти Excel - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » VBA который обрабатывает данные в памяти Excel (Макросы/Sub)
VBA который обрабатывает данные в памяти Excel
IvanK710 Дата: Понедельник, 05.03.2018, 16:35 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

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

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

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

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

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

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

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

Автор - IvanK710
Дата добавления - 05.03.2018 в 16:35
sboy Дата: Понедельник, 05.03.2018, 16:39 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2063
Репутация: 593 ±
Замечаний: 0% ±

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

не пролез) ограничение на объем файла 100кб
 
Ответить
Сообщение
Приаттачил файл

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

Автор - sboy
Дата добавления - 05.03.2018 в 16:39
IvanK710 Дата: Понедельник, 05.03.2018, 16:47 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

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

Приаттачил.
К сообщению приложен файл: superfile.xls(92.5 Kb)
 
Ответить
Сообщениеага, пришлось подчистить )))

Приаттачил.

Автор - IvanK710
Дата добавления - 05.03.2018 в 16:47
IvanK710 Дата: Вторник, 06.03.2018, 13:23 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 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
 
Ответить
СообщениеДобавил в файл вот этот код, который закидывает данные в память. Подскажите, все правильно? Как мне теперь вытащить из него необходимые данные? :-)

[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]

Автор - IvanK710
Дата добавления - 06.03.2018 в 13:23
SLAVICK Дата: Вторник, 06.03.2018, 15:37 | Сообщение № 5
Группа: Модераторы
Ранг: Старожил
Сообщений: 2256
Репутация: 748 ±
Замечаний: 0% ±

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

Зачем так усложнять?
можно просто так сделать:
[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]


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
все правильно? Как мне теперь вытащить из него необходимые данные?

Зачем так усложнять?
можно просто так сделать:
[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]

Автор - SLAVICK
Дата добавления - 06.03.2018 в 15:37
IvanK710 Дата: Вторник, 06.03.2018, 16:28 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 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")

 
Ответить
Сообщение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:28
IvanK710 Дата: Вторник, 06.03.2018, 16:43 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

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

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


Сообщение отредактировал IvanK710 - Вторник, 06.03.2018, 16:44
 
Ответить
Сообщениенемного упрощу и перефразирую задачу - мне нужно загнать один лист (Data1) в массив и вставить на лист значение вот этой формулы:
Код

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

Автор - IvanK710
Дата добавления - 06.03.2018 в 16:43
SLAVICK Дата: Вторник, 06.03.2018, 17:28 | Сообщение № 8
Группа: Модераторы
Ранг: Старожил
Сообщений: 2256
Репутация: 748 ±
Замечаний: 0% ±

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

[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)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение
и вставить на лист значение вот этой формулы:

[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]

Автор - SLAVICK
Дата добавления - 06.03.2018 в 17:28
IvanK710 Дата: Вторник, 06.03.2018, 17:56 | Сообщение № 9
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 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,

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

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

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


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

Автор - IvanK710
Дата добавления - 06.03.2018 в 17:56
SLAVICK Дата: Среда, 07.03.2018, 10:42 | Сообщение № 10
Группа: Модераторы
Ранг: Старожил
Сообщений: 2256
Репутация: 748 ±
Замечаний: 0% ±

2007,2010,2013,2016
Ваша вторая формула - в корни отличается от первой.
В Вашем случае - легче использовать 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]
Но все Ваши остальные формулы или сами переводите, или отдельными темами, с указанием формулы хотите перевести в массивы...
К сообщению приложен файл: 8884854-2-.xlsm(49.8 Kb) · 8884854-2-2018-.xlsm(53.1 Kb)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
СообщениеВаша вторая формула - в корни отличается от первой.
В Вашем случае - легче использовать 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]
Но все Ваши остальные формулы или сами переводите, или отдельными темами, с указанием формулы хотите перевести в массивы...

Автор - SLAVICK
Дата добавления - 07.03.2018 в 10:42
IvanK710 Дата: Среда, 07.03.2018, 12:32 | Сообщение № 11
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

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


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

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

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