Подсчитать и сравнить. Не совпавшие вывести Подсчитать мона так: [vba]
Код
Sub Отработано() With Лист1 m = .Range("A1").Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 6) End With With CreateObject("Scripting.Dictionary") For i = 1 To UBound(m) .Item(m(i, 1)) = .Item(m(i, 1)) + m(i, 6) Next i Лист1.Range("L1").Resize(.Count) = Application.Transpose(.keys) Лист1.Range("M1").Resize(.Count) = Application.Transpose(.items) End With End Sub
[/vba]
Подсчитать и сравнить. Не совпавшие вывести Подсчитать мона так: [vba]
Код
Sub Отработано() With Лист1 m = .Range("A1").Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 6) End With With CreateObject("Scripting.Dictionary") For i = 1 To UBound(m) .Item(m(i, 1)) = .Item(m(i, 1)) + m(i, 6) Next i Лист1.Range("L1").Resize(.Count) = Application.Transpose(.keys) Лист1.Range("M1").Resize(.Count) = Application.Transpose(.items) End With End Sub
Sub Отработано() Dim K, M, i, OD Set OD = CreateObject("Scripting.Dictionary") With Лист1 M = .Range("A2").Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 8) End With
With Лист2 K = .Range("A2").Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 12) End With
For i = 1 To UBound(M) If M(i, 1) <> "" Then OD(M(i, 1)) = OD(M(i, 1)) + M(i, 6) Next i
For i = 1 To UBound(K) If K(i, 1) <> "" Then OD(K(i, 1)) = OD(K(i, 1)) - K(i, 12) Next i
For Each i In OD.keys If OD.Item(i) = 0 Then OD.Remove (i) Next
With Worksheets.Add .Range("A1").Resize(OD.Count) = Application.Transpose(OD.keys) .Range("B1").Resize(OD.Count) = Application.Transpose(OD.items) .Columns(1).ColumnWidth = 15 End With
End Sub
[/vba]
Цитата
я уже не знаю, что делать
Вникать! [vba]
Код
Option Explicit
Sub Отработано() Dim K, M, i, OD Set OD = CreateObject("Scripting.Dictionary") With Лист1 M = .Range("A2").Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 8) End With
With Лист2 K = .Range("A2").Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 12) End With
For i = 1 To UBound(M) If M(i, 1) <> "" Then OD(M(i, 1)) = OD(M(i, 1)) + M(i, 6) Next i
For i = 1 To UBound(K) If K(i, 1) <> "" Then OD(K(i, 1)) = OD(K(i, 1)) - K(i, 12) Next i
For Each i In OD.keys If OD.Item(i) = 0 Then OD.Remove (i) Next
With Worksheets.Add .Range("A1").Resize(OD.Count) = Application.Transpose(OD.keys) .Range("B1").Resize(OD.Count) = Application.Transpose(OD.items) .Columns(1).ColumnWidth = 15 End With