Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d_ As Range, d1_ As Range
    Set d_ = Intersect(Range("ak9:ak34"), Target)
    If Not d_ Is Nothing Then
        For Each d1_ In d_
            With ActiveSheet.Shapes(d1_.Row - 8).Fill
                Select Case d1_.Value
                    Case Is < 15
                        .Transparency = 0.92
                    Case Is < 20
                        .Transparency = 0.74
                    Case Is < 50
                        .Transparency = 0.52
                    Case Else
                        .Transparency = 0.37
                End Select
            End With
        Next d1_
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim rng As Range
    Dim i As Integer
    
    Set rng = Intersect(Range("ak9:ak34"), Target)
    If Not rng Is Nothing Then
        For i = 1 To rng.Count
         With ActiveSheet.Shapes(Target.Row - 8).Fill
             Select Case Target.Value
                 Case Is < 15
                     .Transparency = 0.92
                 Case Is < 20
                     .Transparency = 0.74
                 Case Is < 50
                     .Transparency = 0.52
                 Case Else
                     .Transparency = 0.37
             End Select
         End With
      Next i
    End If
    
End Sub

Sub Значение_Приобретения()
    r1_ = Range("AM" & Rows.Count).End(3).Row 'здесь
    Range("AK9:AK" & r1_) = Range("AM9:AM" & r1_).Value 'здесь
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d_ As Range, d1_ As Range
    r1_ = Range("AM" & Rows.Count).End(3).Row 'здесь
    Set d_ = Intersect(Range("ak9:ak" & r1_), Target) 'здесь
    If Not d_ Is Nothing Then
        For Each d1_ In d_
            With ActiveSheet.Shapes(CStr(d1_.Row - 8)).Fill 'здесь
                Select Case d1_.Value
                    Case Is < 15
                        .Transparency = 0.92
                    Case Is < 20
                        .Transparency = 0.74
                    Case Is < 50
                        .Transparency = 0.52
                    Case Else
                        .Transparency = 0.37
                End Select
            End With
        Next d1_
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d_ As Range, d1_ As Range
    r1_ = Range("AM" & Rows.Count).End(3).Row
    Set d_ = Intersect(Range("ak9:ak" & r1_), Target)
    If Not d_ Is Nothing Then
        For Each d1_ In d_
            Select Case d1_.Value
                Case Is < 15
                    zn_ = 0.92
                Case Is < 20
                    zn_ = 0.74
                Case Is < 50
                    zn_ = 0.52
                Case Else
                    zn_ = 0.37
            End Select
            ActiveSheet.Shapes(d1_.Offset(, -1)).Fill.Transparency = zn_
        Next d1_
    End If
End Sub

Sub Значение_Приобретения()
    r0_ = 9
    r1_ = Range("AM" & Rows.Count).End(3).Row
    If r1_ < r0_ Then Exit Sub
    n_ = r1_ - r0_ + 1
    ar = Range("AJ" & r0_).Resize(n_)
    ar1 = Range("AM" & r0_).Resize(n_)
    Application.EnableEvents = 0
    Range("AK" & r0_).Resize(n_) = ar1
    Application.EnableEvents = 1
    For i = 1 To n_
        Select Case ar1(i, 1)
            Case Is < 15
                zn_ = 0.92
            Case Is < 20
                zn_ = 0.74
            Case Is < 50
                zn_ = 0.52
            Case Else
                zn_ = 0.37
        End Select
    ActiveSheet.Shapes(ar(i, 1)).Fill.Transparency = zn_
    Next i
End Sub