Çözüldü Makro

[sirkülasyon]

Private Sub Worksheet_Activate()
If Not Intersect(Target, [L6:L100]) Is Nothing Then
If Selection.Value = "Asfalt" Then
Selection.Offset(0, 1).Value = 1
ElseIf Selection.Value = "Stabilize" Then
Selection.Offset(0, 1).Value = 1.1
ElseIf Selection.Value = "Toprak" Then
Selection.Offset(0, 1).Value = 1.2
ElseIf Selection.Value = "Asfalt,Karlı,Zincirli" Then
Selection.Offset(0, 1).Value = 1.05
ElseIf Selection.Value = "Stabilize,Karlı,Zincirli" Then
Selection.Offset(0, 1).Value = 1.15
ElseIf Selection.Value = "Toprak,Karlı,Zincirli" Then
Selection.Offset(0, 1).Value = 1.25
ElseIf Selection.Value = "Asfalt,Dağlık,Eğimli" Then
Selection.Offset(0, 1).Value = 1.05
ElseIf Selection.Value = "Stabilize,Dağlık,Eğimli" Then
Selection.Offset(0, 1).Value = 1.15
ElseIf Selection.Value = "Toprak,Dağlık,Eğimli" Then
Selection.Offset(0, 1).Value = 1.25
ElseIf Selection.Value = "Asfalt,Dağlık,Eğimli,Karlı,Zincirli" Then
Selection.Offset(0, 1).Value = 1.1
ElseIf Selection.Value = "Stabilize,Dağlık,Eğimli,Karlı,Zincirli" Then
Selection.Offset(0, 1).Value = 1.2
ElseIf Selection.Value = "Toprak,Dağlık,Eğimli,Karlı,Zincirli" Then
Selection.Offset(0, 1).Value = 1.3
End If
End If
End Sub

Hücrede açılır liste var. Hücrede değişiklik oldukça kod çalışması lazım. Ancak düzeltilmesi lazım. Rica etsem yardımcı olabilir misiniz?

 

[çıtır]

Hücre değişikliğinde kod çalışaçak ise.Aşağıdaki kodu siliniz.

Private Sub Worksheet_Activate()

Yerine aşağıdaki kodu kopyalayınız

Private Sub Worksheet_Change(ByVal Target As Range)

 

[sirkülasyon]

Sayın Çıtır
Teşekkür eder, saygılarımı sunarım

 

[çıtır]

Sayın Çıtır
Teşekkür eder, saygılarımı sunarım

Rica ederim.Dönüş yaptığınız için teşekkür ederim.Bilmukabele.