Soru Muhammen Bedel (2021 Güncelleme)

[sirkülasyon]

4. Satırdan itibaren G hücresi dolu ise
G hücresi 1 ise J hücresi 0,600
G hücresi 2 ise J hücresi 0,605
G hücresi 3 ise J hücresi 0,610
G hücresi 4 ise J hücresi 0,615
G hücresi 5 ise J hücresi 0,620
G hücresi 6 ise J hücresi 0,625
G hücresi 7 ise J hücresi 0,630
G hücresi 8 ise J hücresi 0,635
G hücresi 9 ise J hücresi 0,640
G hücresi 10 ve 50 arasında ise J hücresi 0,645
Boş ise sıfır
işlemini gerçekleştiren kısa bir makroya ihtiyacım var. Yardımcı olabilir misiniz?

 

[sirkülasyon]

Function gosterge(deger As Integer)
If deger = 1 Then gosterge = 0.6
If deger = 2 Then gosterge = 0.605
If deger = 3 Then gosterge = 0.61
If deger = 4 Then gosterge = 0.615
If deger = 5 Then gosterge = 0.62
If deger = 6 Then gosterge = 0.625
If deger = 7 Then gosterge = 0.63
If deger = 8 Then gosterge = 0.635
If deger = 9 Then gosterge = 0.64
If (deger > 9) And (deger < 50) Then gosterge = 0.645
End Function

Bu şekilde uyarladım ama daha kısası mümkün müdür? "Function" kullanılmadan

 

[Haluk]

Sub Test()
    NoG = Range("G" & Rows.Count).End(xlUp).Row
    
    For i = 4 To NoG
        If Range("G" & i) <> "" Then
            Range("J" & i) = Application.Min(0.645, 0.6 + (Range("G" & i) - 1) * 0.005)
        End If
    Next
End Sub

.

 

[sirkülasyon]

REİS teşekkür ederim.

Rica etsem

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("G4:G" & Rows.Count)) Is Nothing Then 'Exit Sub
If Target = "" Then
    Target.Offset(0, 1).ClearContents
ElseIf Target < 1 Then
    Target.Offset(0, 1).ClearContents
ElseIf IsNumeric(Target) = True Then
    Target.Offset(0, 1) = gosterge(Target.Offset(0, 0))
Else
If Not Intersect(Target, Range("B4:B" & Rows.Count)) Is Nothing Then 'Exit Sub
If Target = "" Then
    Target.Offset(0, 1).ClearContents
ElseIf Target < 1 Then
    Target.Offset(0, 1).ClearContents
ElseIf IsNumeric(Target) = True Then
    Target.Offset(0, 1) = kapasite(Target.Offset(0, 0))
Else
If Not Intersect(Target, Range("D4:D" & Rows.Count)) Is Nothing Then 'Exit Sub
If Target = "" Then
    Target.Offset(0, 1).ClearContents
ElseIf Target < 1 Then
    Target.Offset(0, 1).ClearContents
ElseIf Not IsNumeric(Target) = True Then
    Target.Offset(0, 1) = yol(Target.Offset(0, 0))
   
End If
End If

End If
End If

End If
End If
End Sub

Modülde ki kodlar

Function kapasıte(arac As Integer)
If (arac > 10) And (arac < 16) Then kapasıte = 1.25
If (arac > 17) And (arac < 23) Then kapasıte = 1.5
If (arac > 24) And (arac < 29) Then kapasıte = 1.9
If (arac > 30) Then kapasıte = 2.1
End Function

Function yol(durum As Integer)
If durum = "Asfalt yol" Then yol = 1
If durum = "Stabilize yol" Then yol = 1.1
If durum = "Toprak yol" Then yol = 1.15
End Function

Yukarıdaki kodda hatamı giderebilir misiniz?

 

[Haluk]

Bu başka bir soru mu?

.

 

[Mahir64]

Sanırım taşımalı maliyet hesabı.
Çok detaya girmişsiniz sayın @sirkülasyon ufak formüller çözer bu hesabı.

 

[sirkülasyon]

Aynı konu ile ilgili ama ilk sorduğum soru ile alakalı değil Reis

 

[sirkülasyon]

Mahir abim sanmıyorsun tam üstüne basıyorsun.
Bakanlık Pandemi sürecinden dolayı hesaplamayı değiştirmiş.

 

[Mahir64]

Mahir abim sanmıyorsun tam üstüne basıyorsun.
Bakanlık Pandemi sürecinden dolayı hesaplamayı değiştirmiş.

Yıllarca taşımalı da çalıştım (12 yıl kadar). Artık bıraktım.
Dün yeni katsayılara göre güncelledim...
kolay gelsin. Zor iş.