Sub supermacros()
Dim a As Workbook
Set a = ThisWorkbook
k = a.Sheets("Str").Range("G1").End(xlDown).Row
For c = 1 To k
If a.Sheets("Str").Cells(c, 6).Text Like "Ябло*" Then a.Sheets("Str").Cells(c, 6) = "Яблочная продукция"
Next c
End Sub

Sub pupermacros()
Dim a As Workbook
Set a = ThisWorkbook
k = a.Sheets("Str").Range("H1").End(xlDown).Row
For c = 1 To k
If a.Sheets("Str").Cells(c, 6).Text Like "" Then a.Sheets("Str").Cells(c, 6) = "Не определено"
Next c
End Sub