• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

VBA da Toplama

Katılım
22 Mayıs 2009
Mesajlar
1,017
Excel Vers. ve Dili
Office 2003
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [F4:F51]) Is Nothing Then
Cells(sat, "F") = Cells(sat, "B") * Cells(sat, "E")
ElseIf Not Intersect(Target, [H7:H51]) Is Nothing Then
Cells(sat, "H") = Cells(sat, "B") * Cells(sat, "G")
ElseIf Not Intersect(Target, [J7:J51]) Is Nothing Then
Cells(sat, "J") = Cells(sat, "B") * Cells(sat, "I")
End If
End Sub

b4:b51 sütunu ile E4:E51 sütununu F4:F51 sütununa çarpacak
b4:b51 sütunu ile G4:G51 sütununu H4:H51 sütununa çarpacak
b4:b51 sütunu ile I4:I51 sütununu J4:J51 sütununa çarpacak
Şekilde yapmaya çalıştım ama olmadı çözümü için yardımcı olabilir misiniz?
 
yanıt

Bu şekil, deneyiniz.
Sub carp()
Dim sat As Integer
For sat = 1 To Cells(65536, "b").End(xlUp).Row
Cells(sat, "f") = WorksheetFunction.Product(Cells(sat, "b"), Cells(sat, "e"))
Cells(sat, "h") = WorksheetFunction.Product(Cells(sat, "b"), Cells(sat, "g"))
Cells(sat, "j") = WorksheetFunction.Product(Cells(sat, "b"), Cells(sat, "ı"))
Next
End Sub
 
Ziya abi vermiş olduğunuz makro işlem görüyor.
Mümkünse bunu düğmeye bağlamadan yaptırabilmemiz mümkün mü
Bu konuda da yardımlarınızı bekliyorum inşallah
 
yanıt

Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sat As Integer
For sat = 1 To Cells(65536, "b").End(xlUp).Row
Cells(sat, "f") = WorksheetFunction.Product(Cells(sat, "b"), Cells(sat, "e"))
Cells(sat, "h") = WorksheetFunction.Product(Cells(sat, "b"), Cells(sat, "g"))
Cells(sat, "j") = WorksheetFunction.Product(Cells(sat, "b"), Cells(sat, "ı"))
Next
End Sub
 
Ziya Abi Allah yar ve Yardımcın olsun.

Zahmet verdim size Hakkınızı Helal Edin inşallah
 
Rica ederim. Sayın Yesilyurtlu
 
Geri
Üst