Sub Обновить_остаток()
   Dim dic_texn, cell_texn, cell_kompl
   
   On Error Resume Next
   Set dic_texn = CreateObject("Scripting.Dictionary")
   With Sheets("1")
      .Cells(2, 4).Resize(Application.CountA(.[D:D]) - 1, 1).ClearContents
      For Each cell_texn In .Cells(2, 6).Resize(Application.CountA(.[F:F]) - 1, 1)
         If Not dic_texn.exists(cell_texn.Value) Then
            dic_texn.Add Key:=cell_texn.Value, Item:=0&
         End If
      Next
      For Each cell_kompl In .Cells(2, 2).Resize(Application.CountA(.[A:A]), 1)
         If cell_kompl.Value <> 0 Then
            dic_texn.Remove cell_kompl.Value
         End If
      Next
      .Cells(2, 4).Resize(dic_texn.Count) = Application.Transpose(dic_texn.Keys)
   End With
End Sub