eğersay ve düşeyara formülü hk.

[kemal turan]

Merhaba,
Dosyamızda bulunan Eğersay ve Düşeyara formüllerinin makro ile yapılmasına ihtiyacım var.
Örnek dosyada açıkladım.
Yardımlarınız için teşekkür ederim.

 

[Ömer]

Merhaba,

Çalışma sayfasının kod bölümüne kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim c As Range
 
    If Intersect(Target, Range("D:D")) Is Nothing Then Exit Sub
    
    With Target
        If .Row < 2 Then Exit Sub
        Range("K" & .Row & ":L" & .Row).ClearContents
        If .Value = "" Then Exit Sub
        Set c = [O:O].Find(.Value, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Cells(.Row, "K") = "HEMEN SEVK OLACAK"
            Cells(.Row, "L") = Cells(c.Row, "P")
        End If
    End With
 
End Sub

.

 

[kemal turan]

Merhaba Ömer bey,
Emeğinize sağlık çok teşekkür ederim.
Selametle kalınız.

 

[kemal turan]

Merhaba Ömer bey,
Verdiğiniz çözüme bir kod daha ekledim.sorun çıktı.

sorun 1 :E sutunundaki değeri sildiğimde makro çalışmıyor yani E ve G sutununu çarpmıyor.
sorun 2 :Satırın tamamını sildiğimde de ekran donuyor.

Teşekkür ederim.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim c As Range
    On Error GoTo son
    If Intersect(Target, Range("E7335:E" & Rows.Count)) Is Nothing Then Exit Sub
With Target
Cells(.Row, "I").Value = Cells(.Row, "e").Value * Cells(.Row, "G").Value
.Value = .Value
End With
son:
    If Intersect(Target, Range("D:D")) Is Nothing Then Exit Sub
    
    With Target
        If .Row < 2 Then Exit Sub
        Range("K" & .Row & ":L" & .Row).ClearContents
    
        Set c = [O:O].Find(.Value, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Cells(.Row, "K") = "HEMEN SEVK OLACAK"
            Cells(.Row, "L") = Cells(c.Row, "P")
        End If
End With

End Sub

 

[kemal turan]

veya benim eklediğim kodu unutursak;
2 nolu mesajınızdaki kodunuza aşağıdaki işlemi yapacak bir kod ekleyebilirmiyiz.

E sutununa bir değer girdiğimde E ile G sutunundaki değeri çarpacak I sutununa yazacak.
Teşekkür ederim.

 

[Ömer]

Bu şekilde deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim c As Range
 
    If Intersect(Target, Range("D:D,E:E")) Is Nothing Then Exit Sub
    
    With Target
        If .Column = 4 Then
            If .Row < 2 Then Exit Sub
            Range("K" & .Row & ":L" & .Row).ClearContents
            If .Value = "" Then Exit Sub
            Set c = [O:O].Find(.Value, , xlValues, xlWhole)
            If Not c Is Nothing Then
                Cells(.Row, "K") = "HEMEN SEVK OLACAK"
                Cells(.Row, "L") = Cells(c.Row, "P")
            End If
        End If
        If .Column = 5 Then
            Cells(.Row, "I") = .Value * Cells(.Row, "G")
        End If
    End With
 
End Sub

.

 

[kemal turan]

Merhaba ömer bey,
Çok teşekkür ederim, emeğinize sağlık.
Selametle kalınız.