• DİKKAT

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

makro ile 4 işlem

Katılım
8 Kasım 2009
Mesajlar
68
Excel Vers. ve Dili
2003
Selamlar
Aşağıdaki dosyada b23 ile j 46 arasındaki hücrelerden herhangi birine bir veri girişi yapıldığında aynı sütundaki 3 sayı ile ve kendisi ile çarpacak.Örneğin b23 hücresi için b23=($b$8*$b$9*$b$10)*b23 c23=(c8*c9*c10 )*c23 makro ile yapmak istiyorum.Dosya aşağıda.Tşler.
 

Ekli dosyalar

Dosyanız ektedir.:cool:
Kod:
Sub carp()
Dim hcr As Range
For Each hcr In Range("B23:J46")
    hcr.Value = Cells(8, hcr.Column).Value * Cells(9, hcr.Column).Value _
    * Cells(10, hcr.Column).Value * hcr.Value
Next
MsgBox "Çarpma işlemi bitti" & vbLf & _
vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
 

Ekli dosyalar

Teşekkür ediyorum evren bey yanlız virgülden sora 2 haneli göstermek istiyorum.Makroyu Sayfaya yazdığımda hücreye değer girince bu aralıktaki her hücreye tıkladığımda değer değişiyor ve sonsuz değer gösteriyor.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim hcr As Range
For Each hcr In Range("B23:J46")
hcr.Value = ((Cells(8, hcr.Column).Value * Cells(9, hcr.Column).Value _
* Cells(10, hcr.Column).Value) / 1000000000) * hcr.Value
Next
End Sub
 
Son düzenleme:
Teşekkür ediyorum evren bey yanlız virgülden sora 2 haneli göstermek istiyorum.Makroyu Sayfaya yazdığımda hücreye değer girince bu aralıktaki her hücreye tıkladığımda değer değişiyor ve sonsuz değer gösteriyor.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim hcr As Range
For Each hcr In Range("B23:J46")
hcr.Value = ((Cells(8, hcr.Column).Value * Cells(9, hcr.Column).Value _
* Cells(10, hcr.Column).Value) / 1000000000) * hcr.Value
Next
End Sub
Tekrar bu şekle göre düzenledim.Ben onu atlamışım.
Dosyanız ektedir.:cool:
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B23:J46]) Is Nothing Then Exit Sub
Application.EnableEvents = False
Target.Value = Cells(8, Target.Column).Value * Cells(9, Target.Column).Value _
    * Cells(10, Target.Column).Value * Target.Value
Application.EnableEvents = True
End Sub
 

Ekli dosyalar

Evren bey gönderdiğiniz dosyada b23 ile j 45 arasına değer giriyorum ancak hiç çalışmıyor.Saygılar.
 
Evren bey gönderdiğiniz dosyada b23 ile j 45 arasına değer giriyorum ancak makro çalışmıyor.Saygılar.
 
v2 dosyasına baktım demekki benim bilgisayarda bir tuaflık var.Teşekkür ederim.
 
Geri
Üst