Makro ile sütundaki her satırda çarpma işlemi

[ulutanas]

Merhaba

Arkadaşlar konu hakkında sitemizde ki örnekleri inceledim ve isteğime uygun şekilde bir kod buldum lakin ufak bir kaç değişiklik yapmaya çalışsam da başaramadım Yardımcı olursanız memnun olurum.

Kullanmış olduğum sayfada ki D sütununda adet miktari ile Z sütunundaki birim fiyatının çarpımını E sütununa makro ile yazdırıyorum.
Aşağıdaki kod yardımı ile

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

If Intersect(Target, [D4:Z1000]) Is Nothing Then Exit Sub
sat = Target.Row
Cells(sat, "E") = Cells(sat, "D") * Cells(sat, "Z")

End Sub

Fakat bu koda göre Z4 den Z1000 kadar birim fiyatı bedelini yazmak zorundayım. bunun yerine Z sütununda bir hücreye (örneğin Z1) bir kere birim fiyatı girsem ve D sütununda her satırda girilen değeri Z1 hücresindeki değere göre çarpım yapsa olurmu.

Birde bu koda göre D sütununa rakam girdiğim zaman otomatik çarpma işlemi yapmıyor illaki E sütununa gitmem gerekiyor buna da bir çözüm yolu var mı acaba?

Yardımcı olursanız memnun olurum.

İyi çalışmalar

Saygılarımla...

 

[Emir Hüseyin Çoban]

. . .

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

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D4:D65536]) Is Nothing Then Exit Sub
sat = Target.Row
Cells(sat, "E") = Cells(sat, "D") * Range("Z1")
End Sub

. . .

 

[ulutanas]

Teşekkürler Hüseyin hocam bugün harikasınız her kese derman oluyorsunuz maşallah.

İyi çalışmalar

Saygılarımla...

 

[ulutanas]

Hüseyin hocam aynı sayfada H sütunu ile z1 in çarpımını ı sütununa almak istedim ve aşağıdaki kodu ekledim kodda hata vermiyor ama işlemde yapmıyor

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D465536]) Is Nothing Then Exit Sub
sat = Target.Row
Cells(sat, "E") = Cells(sat, "D") * Range("Z1")

If Intersect(Target, [h4:h65536]) Is Nothing Then Exit Sub
sat = Target.Row
Cells(sat, "ı") = Cells(sat, "h") * Range("Z1")
End Sub


Yardımcı olursanız yine memnun olurum hayırlı sahurlar

İyi çalışmalar

Saygılarımla..

 

[Emir Hüseyin Çoban]

. . .

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("D4:D65536")) Is Nothing Then
        sat = Target.Row
        Cells(sat, "E") = Cells(sat, "D") * Range("Z1")
    Else
        If Not Intersect(Target, Range("H4:H65536")) Is Nothing Then
            sat = Target.Row
            Cells(sat, "ı") = Cells(sat, "h") * Range("Z1")
        End If
    End If
End Sub

Tıkla ~ Code Tagları Kullanımı Hk.

. . .

 

[ulutanas]

Bir deneme daha yaptım N sütununu z1 ile çarpımını O sütununa yazsın diye, deneme başarılı. Bir konu hakkında daha sayenizde bilgi sahibi oldum.
Çok teşekkürler Hüseyin hocam.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("D4:D65536")) Is Nothing Then
        sat = Target.Row
        Cells(sat, "E") = Cells(sat, "D") * Range("Z1")
    Else
        If Not Intersect(Target, Range("H4:H65536")) Is Nothing Then
            sat = Target.Row
            Cells(sat, "ı") = Cells(sat, "h") * Range("Z1")
    Else
        If Not Intersect(Target, Range("N4:N65536")) Is Nothing Then
            sat = Target.Row
            Cells(sat, "O") = Cells(sat, "N") * Range("Z1")
        End If
    End If
   End If
End Sub

İyi çalışmalar

Saygılarımla..

 

[ulutanas]

Arkadaşlar yine aynı dosya içerisinde aynı konuyla alakalı başka bir sıkıntı ile karşı karşılaştım sorunla ilgili örnek bir dosya ekledim yardımcı olursanız mumnun olurum

İyi çalışmalar

Saygılarımla...

 

[Emir Hüseyin Çoban]

. . .

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    On Error Resume Next
    
    If Not Intersect(Target, Range("A3:A65536")) Is Nothing Then
        sat = Target.Row
        Cells(sat, "B") = Cells(sat, "A") * Range("Z1")
    End If
    
    Range("C3") = Range("B3")
    Range("E3") = Range("C3")
    For i = 4 To [A65536].End(3).Row-1
        Cells(i, "C") = Cells(i - 1, "C") + Cells(i, "B")
        Cells(i, "E") = (Cells(i - 1, "E") + Cells(i, "B")) - Cells(i, "D")
    Next i
    
    Application.EnableEvents = True
End Sub

. . .

 

[ulutanas]

Hüseyin hocam çok teşekkürler işlem işliyor lakin saniye geçmeden dosya kitleniyor
Bunun sebebi ne olabilir. Benim pc demi bir sorun var yoksa?

 

[ulutanas]

Application.EnableEvents = False [CODE]

Pardon hocam bu satırı eklememişim. Emeğinize sağlık çok teşekkür ederim.

İyi çalışmalar

Saygılarımla...