Sub qqq()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    fVal = Range("A1").Value
    rVal = Range("C1").Value
    
    For i = 10 To lRow
        If Cells(i, 2).Value Like "*" & fVal & "*" Then
            Cells(i, 3).Value = rVal
        End If
    Next i
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "done!"
End Sub

Private Sub UserForm_Initialize()
    Dim i As Long, j As Long
    Set dicTemp = CreateObject("Scripting.Dictionary")
 
    For i = 7 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(i, 1).Font.Color = RGB(255, 0, 0) Then
           If Not dicTemp.Exists(Cells(i, 1).Value & "|" & i) Then dicTemp.Add i, Cells(i, 1).Value & "|" & i
           j = j + 1
        End If
    Next
    arr = dicTemp.Items
    SortArray arr
    
    j = 0
    For Each it In arr
        m = Split(it, "|")
        ListBox1.AddItem m(UBound(m))
        ListBox1.List(j, 1) = Cells(m(UBound(m)), 1)
        j = j + 1
    Next
End Sub

Private Sub UserForm_Initialize()
Dim i As Long, j As Long
 Set dicTemp = CreateObject("Scripting.Dictionary")

    For i = 7 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(i, 1).Font.Color = RGB(255, 0, 0) Then
           If Not dicTemp.Exists(Cells(i, 1).Value) Then dicTemp.Add Cells(i, 1).Value, Cells(i, 1).Value
           
'           ListBox1.AddItem Cells(i, 1).Value
'           ListBox1.List(j, 1) = Cells(i, 1)
           j = j + 1
        End If
    Next
    arr = dicTemp.Items
    SortArray arr
    ListBox1.List = arr
End Sub

cells(1,1).value = cells(1,2).value 

Function Кратность(Поставка As Double, Продажи As Range) As Variant
    arr = Продажи.Value
    q = 0
    For i = 1 To IIf(UBound(arr, 1) = 1, UBound(arr, 2), UBound(arr, 1))
        If UBound(arr, 1) = 1 Then
            q = q + arr(1, i)
        Else
            q = q + arr(i, 1)
        End If
        If q >= Поставка Then
            Кратность = i
            Exit Function
        End If
    Next i
    
    Кратность = "не найдено"
End Function