Доброго времени. Подскажите пожалуйста можно ли доработать макрос чтобы если при сравнении нет в одной таблицы переносил всю строку с ее данными в новую в той же последовательности(очередности) что и была с комментарием в соседнем столбце "позиция удалена"
Исходные данные - есть в книги (листа) старые данные и новые данные - макрос по сцепке проверяет данные и при нахождении расхождении записывает комментарий, но что ли как обратно его скорректировать (запустить) на проверку не пойму
Исходные данные - есть в книги (листа) старые данные и новые данные - макрос по сцепке проверяет данные и при нахождении расхождении записывает комментарий, но что ли как обратно его скорректировать (запустить) на проверку не пойму
Код |
---|
Sub mrshkei() Dim sh As Worksheet, sh2 As Worksheet, arr, arr2, arr3 Dim i As Long, n As Long, k As Long, lr As Long, lr2 As Long Set sh = Worksheets("Íîâàÿ_ïàðòèÿ"): Set sh2 = Worksheets("Ñòàðàÿ_ïàðòèÿ") lr = sh.Cells(Rows.Count, 1).End(xlUp).Row lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row arr = sh.Range("A1:J" & lr) arr2 = sh2.Range("A1:I" & lr2) ReDim arr3(1 To UBound(arr), 1 To 2) For i = LBound(arr) + 1 To UBound(arr) k = 0 For n = LBound(arr2) + 1 To UBound(arr2) If arr(i, 1) = arr2(n, 1) Then k = k + 1 If arr(i, 7) - arr2(n, 7) <> 0 Then arr3(i - 1, 1) = "èçìåíåíèå îáúåìà" arr3(i - 1, 2) = arr2(i - 1, 7) Exit For Else arr3(i - 1, 1) = Empty arr3(i - 1, 2) = Empty End If End If If k = 0 Then arr3(i - 1, 1) = "äà" arr3(i - 1, 2) = "íîâàÿ ïîçèöèÿ" End If Next n Next i sh.Range("I2").Resize(UBound(arr3), 2) = arr3 End Sub |