For.Next Döngüsü

[ykslkrtl]

Forumda ögrendiklerimle kendime calışma programı yaptım,
Yanlız takıldıgım 2 konuda sizin yardımınız gerekiyor

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Integer
For a = 4 To Range("A65536").End(3).Row
Range("L" & a) = (Range("K" & a) * Range("D" & a))
Next a
End Sub

Kullanmış olduğum kod bu, K ve D sütununa veriler otomatik aktarıyorum , for next döngüsü işimi görüyor ,ama takıldığım ve cözemedigim yer K ve D sütununa verileri manüel olarak girdiğimde for döngüsünün sadece manüel olarak girdiğim hücrede çalışması,
Yani sadece degişen hüçrenin for döngüsüne takılmamasını istiyorum, carpma işlemini bütün hüçrelerde tekrardan yapmamasını istiyorum, [ilginc]
Excel vb daha yeniyim , pek beceremedim

2 takıldıgım konu:Aynı kodları farklı hüçrelerde kullanamıyorum
"Private Sub Worksheet_Change(ByVal Target As Range)" 2.kez kulanmam için ne yapmam gerekiyor

 

[Huseyinkis]

Eğer sadece işlem yaptığınız hücrede çalışmasını istiyorsanız döngü yapmayın.

Kodları denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Integer
If Intersect(Target, Range("D:K")) Is Nothing Then Exit Sub
a = Target.Row
Range("L" & a) = (Range("K" & a) * Range("D" & a))

End Sub

 

[Orion1]

Dim a as integer

Bu tanımı değiştirin.
integer boyutu 32767 sayısına kadar sayıları alabilir.
Eğer 32768 satıra gelirse veri taşması olur, ve hata verir.
Onun için integer yerine long kullanın.

dim a as long

 

[ykslkrtl]

Verdiginiz İki kodda sorunsuz çalışdı,teşekkür ederim,
Peki 2.sorum için nasıl bir yol izlemem gerekiyor

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Integer
If Intersect(Target, Range("D:K")) Is Nothing Then Exit Sub
a = Target.Row
Range("L" & a) = (Range("K" & a) * Range("D" & a))
End Sub

Aynı olayı farklı hüçrelerde denemem için ne yapmam lazım,"Private Sub Worksheet_Change(ByVal Target As Range" 2.kez kullanamıyorum hata veriyor.
Yani yapmak istedigim olay ; 2 kodu tek seferde calıştırıcam

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Integer
If Intersect(Target, Range("D:K")) Is Nothing Then Exit Sub
a = Target.Row
Range("I" & a) = (Range("e" & a) + Range("f" & a) + Range("g" & a) * Range("c" & a) - Range("h" & a))
Next a
End Sub

 

[YUSUF44]

VErdiğiniz 2 kodun birleşimi aşağıdaki şekilde olur. Ancak ikinci koddaki Next a satırı For olmadan işe yaramaz, ne amaçla orda bilemedim:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Integer
If Intersect(Target, Range("D:K")) Is Nothing Then Exit Sub
a = Target.Row
Range("L" & a) = (Range("K" & a) * Range("D" & a))
Range("I" & a) = (Range("e" & a) + Range("f" & a) + Range("g" & a) * Range("c" & a) - Range("h" & a))
End Sub

 

[ykslkrtl]

Forumdaki örnekler ve sizin örneklerinizden yola cıkarak bu şekilde kod yazdım;
Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Integer

If Not Intersect(Target, Range("E:E,F:F,G:G")) Is Nothing Then
If IsNumeric(Target) Then
a = Target.Row
Range("I" & a) = (Range("E" & a) + Range("F" & a) + Range("G" & a) * Range("C" & a) - Range("H" & a))
End If
Exit Sub
End If

If Not Intersect(Target, Range("D,K:K")) Is Nothing Then
If IsNumeric(Target) Then
a = Target.Row
Range("L" & a) = (Range("K" & a) * Range("D" & a))
End If
End If
Exit Sub

End Sub


Bişey daha sormak istiyorum,kusura bakmayın ,sora sora ögrenicem
Bu kodların arasına L4:L30000 arasındaki sayıların yada L4 den başlayıp en son boş hüçreye kadar ki sonuçlarını K2 hüçresinde gösteren alt toplam nasıl eklerim

 

[YUSUF44]

[K2]=Worksheetfunction.Sum(Range("L4:L30000"))

Ya da

[K2]=Worksheetfunction.Sum(Range("L4:L" & cells(rows.count,"L").end(3).row))

 

[ykslkrtl]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Integer

If Not Intersect(Target, Range("E:E,F:F,G:G,C:C,H:H")) Is Nothing Then
If IsNumeric(Target) Then
a = Target.Row
Range("I" & a) = (Range("E" & a) + Range("F" & a) + Range("G" & a) * Range("C" & a) - Range("H" & a))
End If
Exit Sub
End If

If Not Intersect(Target, Range("J:J,I:I")) Is Nothing Then
If IsNumeric(Target) Then
a = Target.Row
Range("K" & a) = (Range("J" & a) - Range("I" & a))
End If
Exit Sub
End If

If Not Intersect(Target, Range("D,K:K")) Is Nothing Then
If IsNumeric(Target) Then
a = Target.Row
Range("L" & a) = (Range("K" & a) * Range("D" & a))
End If
Range("K2") = WorksheetFunction.Sum(Range("L4:L" & Cells(Rows.Count, "L").End(3).Row))
Range("I2") = WorksheetFunction.Max(Sheets("MAL SATIŞ RAPORU").Range("I14:I" & Cells(Rows.Count, "I").End(3).Row))
End If
Exit Sub

End Sub

Yusuf kardeşim sana bir soru daha sormam lazım, af buyur, excel vb da yeniyim.Normal olarak excel formulleriyle kolay oluyor ama vba da ögrenmeye çalışıyorum.
Vermiş oldugun alt toplam sorunsuz calışdı,ama ben bir alt satıra Range("I2") = WorksheetFunction.Max(Sheets("MAL SATIŞ RAPORU").Range("I14:I" & Cells(Rows.Count, "I").End(3).Row))
bu kodu ekledim,amacım başka bir sheets sayfasındaki I sütünundaki en büyük degeri bulmaktı.Ama hata verdi,excel programı sonlanıyor,ya ben yanlış yere yazdım kodu,yada kodu yanlış satıra yazdım.Nerde hata yaptım ben

 

[YUSUF44]

Böyle anlamak zor ama şöyle deneyin:

Range("I2") = WorksheetFunction.Max(Sheets("MAL SATIŞ RAPORU").Range("I14:I" & Sheets("MAL SATIŞ RAPORU").Cells(Rows.Count, "I").End(3).Row))

 

[ykslkrtl]

Arkadaşlar tekrar yardımınız gerekiyor.

STOKKARTI sayfasına yazdıgım kodlarla , diğer sayfalarda bulunan sayısal verileri CommandButton1_Click vasıtasıyla cekiyorum

[SIZE="3"]Private Sub ()
Dim a As Integer
For a = 4 To Range("A65536").End(3).Row
Range("F" & a) = WorksheetFunction.SumIf(Sheets("GELEN").Range("B:B"), Sheets("STOKKARTI").Range("A" & a), Sheets("GELEN").Range("K:K"))
Range("E" & a) = WorksheetFunction.SumIf(Sheets("BAŞLANGIÇ").Range("D:D"), Sheets("STOKKARTI").Range("A" & a), Sheets("BAŞLANGIC").Range("I:I"))
Range("H" & a) = WorksheetFunction.SumIf(Sheets("MAL SATIŞ RAPORU").Range("A:A"), Sheets("STOKKARTI").Range("A" & a), Sheets("MAL SATIŞ RAPORU").Range("F:F"))
Range("I" & a) = (Range("e" & a) + Range("f" & a) + Range("g" & a) * Range("c" & a) - Range("h" & a))
Range("J" & a) = WorksheetFunction.SumIf(Sheets("BİTİŞ").Range("D:D"), Sheets("STOKKARTI").Range("A" & a), Sheets("BİTİŞ").Range("I:I"))
Next a
End Sub[/SIZE]

STOKKART'a gelen sayısal verilerin , bazen mauel degiştirmek gerektigi için yazmış oldugum kodlar bunlar.

[SIZE="2"]Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Integer
If Not Intersect(Target, Range("E:E,F:F,G:G,C:C,H:H")) Is Nothing Then
a = Target.Row
Range("I" & a) = (Range("E" & a) + Range("F" & a) + Range("G" & a) * Range("C" & a) - Range("H" & a))
End If
If Not Intersect(Target, Range("D:D,K:K")) Is Nothing Then
a = Target.Row
Range("L" & a) = (Range("K" & a) * Range("D" & a))
End If
If Not Intersect(Target, Range("J:J,I:I")) Is Nothing Then
a = Target.Row
Range("K" & a) = (Range("J" & a) - Range("I" & a))
End If
If Not Intersect(Target, Range("I:I")) Is Nothing Then
a = Target.Row
Range("K2") = WorksheetFunction.Max(Sheets("MAL SATIŞ RAPORU").Range("I14:I" & Sheets("MAL SATIŞ RAPORU").Cells(Rows.Count, "I").End(3).Row))
Range("K1") = WorksheetFunction.Sum(Range("L4:L" & Cells(Rows.Count, "L").End(3).Row))
End If
If Not Intersect(Target, Range("I:I")) Is Nothing Then
a = Target.Row
Range("K1") = WorksheetFunction.Sum(Range("L4:L" & Cells(Rows.Count, "L").End(3).Row))
End If
End Sub[/SIZE]

Sizden istedigim ve benim beçeremedigim konu;
GELEN, BAŞLANGIÇ, MAL SATIŞ RAPORU, ve BİTİŞ sayfalarındaki veriler kopyala yapıştır ile geliyor.Bu sayfalardaki veriler her degiştiginde STOKKART'ındaki kodların calışması .
CommandButton1_Click butonuna calıştıgında excel kasma oluyor ,ve işlemin bitmesi 5 dk sürüyor

Bu sorunu nasıl halladerim ve nerde hata yaptıgımı merak ediyorum.
Yardım eden herkezden Allah razı olsun.