Вкратце: для заказа 1 просуммировано поле Занаряжено (для всех позиций данного заказа) и вычтена сумма по полю Отгружено (для всех позиций данного заказа) .Ответ 412 занесен только в одну ячейку (позицию) для данного заказа, в остальные 0) и т.д. для других заказов. Заказ может иметь начальной любую позицию, (т.е. 10,20,30 ... не обязательно начинаться с 10.)
Образец с формулой массива во вложении. Помогите, пжл с макросом. Данных очень много, массивы будут тормозить.... Спасибо.
Всем привет, нужна помощь.
Помогите с макросом...
Вкратце: для заказа 1 просуммировано поле Занаряжено (для всех позиций данного заказа) и вычтена сумма по полю Отгружено (для всех позиций данного заказа) .Ответ 412 занесен только в одну ячейку (позицию) для данного заказа, в остальные 0) и т.д. для других заказов. Заказ может иметь начальной любую позицию, (т.е. 10,20,30 ... не обязательно начинаться с 10.)
Образец с формулой массива во вложении. Помогите, пжл с макросом. Данных очень много, массивы будут тормозить.... Спасибо.Парк
Option Base 1 Sub Сумма() Dim arr As Variant, i&, s$, d& With [B5].CurrentRegion With Intersect(.Offset(1), .Cells) arr = .Value With CreateObject("Scripting.Dictionary") For i = 1 To UBound(arr) s = CStr(arr(i, 1)) d = arr(i, 3) - arr(i, 4) arr(i, 5) = 0 If .Exists(s) Then arr(.Item(s), 5) = arr(.Item(s), 5) + d arr(i, 5) = 0 Else arr(i, 5) = d .Item(s) = i End If Next i End With .Value = arr End With End With End Sub
[/vba] а еще можно немассивную формулу написать для F6 формула
Option Base 1 Sub Сумма() Dim arr As Variant, i&, s$, d& With [B5].CurrentRegion With Intersect(.Offset(1), .Cells) arr = .Value With CreateObject("Scripting.Dictionary") For i = 1 To UBound(arr) s = CStr(arr(i, 1)) d = arr(i, 3) - arr(i, 4) arr(i, 5) = 0 If .Exists(s) Then arr(.Item(s), 5) = arr(.Item(s), 5) + d arr(i, 5) = 0 Else arr(i, 5) = d .Item(s) = i End If Next i End With .Value = arr End With End With End Sub
[/vba] а еще можно немассивную формулу написать для F6 формула
krosav4ig, а можно ли данный макрос запускать автоматически при изменении(дополнении новой строки, изменении старой, вставке копированием и т.д.) любой ячейки из столбца, например, Е, данного листа ?
krosav4ig, а можно ли данный макрос запускать автоматически при изменении(дополнении новой строки, изменении старой, вставке копированием и т.д.) любой ячейки из столбца, например, Е, данного листа ?Парк
запускать автоматически ... из столбца, например, Е, данного листа
Если уже установлен код Сумма(), от krosav4ig, то этот код в модуль листа. [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub PS = Columns("B:E").Find("*", [E1], SearchDirection:=xlPrevious).Row + 1 If Not Application.Intersect(Range("E6:E" & PS), Target) Is Nothing Then Сумма End If End Sub
[/vba] А еще, прошу проверить мой код на большом к-ве данных, На сколько он медленнее кода от krosav4igа. Но до установки предыдущего Private Sub Worksheet_Change, ибо он затормозит оба, и мой и от krosav4igа. [vba]
Код
Sub Сум() Dim i&, sm&, ns& sm = 0: ns = 6 For i = 6 To Columns("B:E").Find("*", [E1], SearchDirection:=xlPrevious).Row If Cells(i, "B") = Cells(i + 1, "B") Then sm = sm + Cells(i, "D") - Cells(i, "E") Else sm = sm + Cells(i, "D") - Cells(i, "E") Cells(ns, "F") = sm ns = i + 1: sm = 0 End If Next End Sub
запускать автоматически ... из столбца, например, Е, данного листа
Если уже установлен код Сумма(), от krosav4ig, то этот код в модуль листа. [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub PS = Columns("B:E").Find("*", [E1], SearchDirection:=xlPrevious).Row + 1 If Not Application.Intersect(Range("E6:E" & PS), Target) Is Nothing Then Сумма End If End Sub
[/vba] А еще, прошу проверить мой код на большом к-ве данных, На сколько он медленнее кода от krosav4igа. Но до установки предыдущего Private Sub Worksheet_Change, ибо он затормозит оба, и мой и от krosav4igа. [vba]
Код
Sub Сум() Dim i&, sm&, ns& sm = 0: ns = 6 For i = 6 To Columns("B:E").Find("*", [E1], SearchDirection:=xlPrevious).Row If Cells(i, "B") = Cells(i + 1, "B") Then sm = sm + Cells(i, "D") - Cells(i, "E") Else sm = sm + Cells(i, "D") - Cells(i, "E") Cells(ns, "F") = sm ns = i + 1: sm = 0 End If Next End Sub