Поиск минимального значения и замена

[ikki_pf]

макрос (по первому файлу)

1. как оно озвучено

Sub t()
  Dim d As Object, a, b, i&, lr&
  Set d = CreateObject("scripting.dictionary")
  With Range([a4], Cells(Rows.Count, 1).End(xlUp))
    a = .Value
    b = .Offset(, 3).Value
  End With
  For i = 1 To UBound(a)
    If d.exists(a(i, 1)) Then
      If d.Item(a(i, 1)) > b(i, 1) Then d.Item(a(i, 1)) = b(i, 1)
    Else
      d.Add a(i, 1), b(i, 1)
    End If
  Next
  For i = 1 To UBound(a)
    b(i, 1) = d.Item(a(i, 1))
  Next
  [d4].Resize(UBound(a)).Value = b
End Sub

2. как оно "по-правильному"

Sub t()
  Dim d As Object, a, b, i&, lr&
  Set d = CreateObject("scripting.dictionary")
  With Range([a4], Cells(Rows.Count, 1).End(xlUp))
    a = .Value
    b = .Offset(, 3).Value
  End With
  For i = 1 To UBound(a)
    If d.exists(a(i, 1)) Then
      If d.Item(a(i, 1)) > b(i, 1) And b(i, 1) > 0 Then d.Item(a(i, 1)) = b(i, 1)
    Else
      d.Add a(i, 1), b(i, 1)
    End If
  Next
  For i = 1 To UBound(a)
    b(i, 1) = d.Item(a(i, 1))
  Next
  [d4].Resize(UBound(a)).Value = b
End Sub

[Artem_85]

Сообщение от ikki_pf

макрос (по первому файлу)

1. как оно озвучено

Sub t()
  Dim d As Object, a, b, i&, lr&
  Set d = CreateObject("scripting.dictionary")
  With Range([a4], Cells(Rows.Count, 1).End(xlUp))
    a = .Value
    b = .Offset(, 3).Value
  End With
  For i = 1 To UBound(a)
    If d.exists(a(i, 1)) Then
      If d.Item(a(i, 1)) > b(i, 1) Then d.Item(a(i, 1)) = b(i, 1)
    Else
      d.Add a(i, 1), b(i, 1)
    End If
  Next
  For i = 1 To UBound(a)
    b(i, 1) = d.Item(a(i, 1))
  Next
  [d4].Resize(UBound(a)).Value = b
End Sub

2. как оно "по-правильному"

Sub t()
  Dim d As Object, a, b, i&, lr&
  Set d = CreateObject("scripting.dictionary")
  With Range([a4], Cells(Rows.Count, 1).End(xlUp))
    a = .Value
    b = .Offset(, 3).Value
  End With
  For i = 1 To UBound(a)
    If d.exists(a(i, 1)) Then
      If d.Item(a(i, 1)) > b(i, 1) And b(i, 1) > 0 Then d.Item(a(i, 1)) = b(i, 1)
    Else
      d.Add a(i, 1), b(i, 1)
    End If
  Next
  For i = 1 To UBound(a)
    b(i, 1) = d.Item(a(i, 1))
  Next
  [d4].Resize(UBound(a)).Value = b
End Sub

или я что то не так делаю или он не работает))))))

[ikki_pf]

Сообщение от Artem_85

или я что то не так делаю или он не работает))))))

не гадалка я
не потомственная
что именно вы делаете, как делаете, и как именно "он" у вас "не работает" - сказать не могу.
но догадываюсь - судя по тому, как вы цитируете посты.

у меня работает.

[Artem_85]

Сообщение от ikki_pf

не гадалка я
не потомственная
что именно вы делаете, как делаете, и как именно "он" у вас "не работает" - сказать не могу.
но догадываюсь - судя по тому, как вы цитируете посты.

у меня работает.

в столбце D большинство нули

[Artem_85]

Все работает...спасибо огромное........)))))))))))

[ikki_pf]

второй макрос тоже немножко нулей даёт.
но это уж вы с исх.данными разбирайтесь.
возможно, где-то в наименованиях неточность.
макрос проверяет ПОЛНОЕ соответствие - с учётом всех кавычек, точек-запятых и пробелов.