Hücrede değer sıfır ise satır kaydır

[1Al2Ver]

Merhabalar,

Belirlenen hücredeki değer sıfır olduğunda, bir aşağıdaki satır, değeri sıfır olan satırın yerini,

Değeri sıfır olan satırın da, en son satırın altında yerini almasını arzulamaktayım,

Değerli katkılarınız için şimdiden teşekkür ederim, saygılarımla.

 

[Necdet]

Merhabalar,

Birşeyler yapmaya çalıştım, inceler misiniz?
Aşağıdaki kodlar ilgili sayfanın kod bölümünde olmalı.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [F4]) Is Nothing Then Exit Sub
If Target.Value <> Target.Offset(0, -1) Then Exit Sub
Sat = [A65536].End(3).Row + 1
Rows("4:4").Select
Selection.Cut
Rows(Sat).Select
Selection.Insert Shift:=xlDown
Target.Select
Son:
End Sub

 

[1Al2Ver]

Merhabalar,

Birşeyler yapmaya çalıştım, inceler misiniz?
Aşağıdaki kodlar ilgili sayfanın kod bölümünde olmalı.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [F4]) Is Nothing Then Exit Sub
If Target.Value <> Target.Offset(0, -1) Then Exit Sub
Sat = [A65536].End(3).Row + 1
Rows("4:4").Select
Selection.Cut
Rows(Sat).Select
Selection.Insert Shift:=xlDown
Target.Select
Son:
End Sub

Sayın Yeşertener, eliniz sağlık,
tablonun 15 satır altında olan başka bir tablonun altına yazıyor ve 1 nci tablodaki verileri siliyor, sanırım 1 nolu tablonun son satırından sonra boş satır olmadığı için yapıyor,teşekkür ederim, saygılarımla.

 

[Necdet]

Merhaba,

Kodları aşağıdaki gibi değiştirip dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [F4]) Is Nothing Then Exit Sub
If Target.Value <> Target.Offset(0, -1) Then Exit Sub
Sat = [A3].End(4).Row + 1
Rows("4:4").Select
Selection.Cut
Rows(Sat).Select
Selection.Insert Shift:=xlDown
Target.Select
Son:
End Sub

 

[1Al2Ver]

Merhaba,

Kodları aşağıdaki gibi değiştirip dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [F4]) Is Nothing Then Exit Sub
If Target.Value <> Target.Offset(0, -1) Then Exit Sub
Sat = [A3].End(4).Row + 1
Rows("4:4").Select
Selection.Cut
Rows(Sat).Select
Selection.Insert Shift:=xlDown
Target.Select
Son:
End Sub

Sayın Yeşertener,
tekrar merhaba, sorun düzeldi,
ancak E11, F11 ve G11'deki hücrelerdeki formüllerden; Örneğin =Topla(E4:E10) iken satırın kayması halinde E4:E10 olan formül E4:E9 olmakta, bunun dışında problem yok, tekrar çok çok teşekkürler, elinize sağlık, saygılar sunarım.

 

[1Al2Ver]

Sayın Yeşertener,
tekrar merhaba, sorun düzeldi,
ancak E11, F11 ve G11'deki hücrelerdeki formüllerden; Örneğin =Topla(E4:E10) iken satırın kayması halinde E4:E10 olan formül E4:E9 olmakta, bunun dışında problem yok, tekrar çok çok teşekkürler, elinize sağlık, saygılar sunarım.

Sayın Yeşertener, iyi geceler,

1) Satırın A:G (G dahil) arası kayması mümkün mü ? (Şimdiki haliyle tüm satır kayıyor)
2) =Topla(E4:E10) iken satırın kayması halinde E4:E10 olan formül E4:E9 formatını alıyor, düzelebilir mi?

Teşekkür ederim.

 

[Necdet]

Merhaba,

Sanırım şimdi oldu, deneyiniz lütfen.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [F4]) Is Nothing Then Exit Sub
If Target.Value <> Target.Offset(0, -1) Then Exit Sub
Sat = [A3].End(4).Row + 1
Range("A4:G4").Select
Application.CutCopyMode = False
Selection.Cut
Range("A" & Sat).Select
Selection.Insert Shift:=xlDown
Range("E" & Sat) = "=SUM(E4:E" & Sat - 1 & ")"
Range("F" & Sat) = "=SUM(F4:F" & Sat - 1 & ")"
Range("G" & Sat) = "=SUM(G4:E" & Sat - 1 & ")"
Son:
End Sub

 

[1Al2Ver]

Merhaba,

Sanırım şimdi oldu, deneyiniz lütfen.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [F4]) Is Nothing Then Exit Sub
If Target.Value <> Target.Offset(0, -1) Then Exit Sub
Sat = [A3].End(4).Row + 1
Range("A4:G4").Select
Application.CutCopyMode = False
Selection.Cut
Range("A" & Sat).Select
Selection.Insert Shift:=xlDown
Range("E" & Sat) = "=SUM(E4:E" & Sat - 1 & ")"
Range("F" & Sat) = "=SUM(F4:F" & Sat - 1 & ")"
Range("G" & Sat) = "=SUM(G4:E" & Sat - 1 & ")"
Son:
End Sub

Sayın Yeşertener, çok çok teşekkür ederim, elinize sağlık, benim için bayağı emek harcadınız, saygılar sunuyorum.

 

[Necdet]

Aman efendim rica ederim.

Emek harcamak demek benim için birşeyler öğrenmek demek.

 

[1Al2Ver]

Merhaba,

Sanırım şimdi oldu, deneyiniz lütfen.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [F4]) Is Nothing Then Exit Sub
If Target.Value <> Target.Offset(0, -1) Then Exit Sub
Sat = [A3].End(4).Row + 1
Range("A4:G4").Select
Application.CutCopyMode = False
Selection.Cut
Range("A" & Sat).Select
Selection.Insert Shift:=xlDown
Range("E" & Sat) = "=SUM(E4:E" & Sat - 1 & ")"
Range("F" & Sat) = "=SUM(F4:F" & Sat - 1 & ")"
Range("G" & Sat) = "=SUM(G4:[COLOR="Red"]E[/COLOR]" & Sat - 1 & ")"
Son:
End Sub

Sayın Yeşertener,

Range("G" & Sat) = "=SUM(G4:E" & Sat - 1 & ")"

Bu harfin "G" olması gerekiyor mu ? Teşekkür ederim.

 

[Necdet]

e tabi

Kopyalayıp üzerinde değişiklik yapınca bazen böyle hatalar oluşuyor, düzeltmemi ister misiniz?

 

[ECYavuz]

Sayın Hocamın izini ile evet ;

Range("G" & Sat) = "=SUM(G4:G" & Sat - 1 & ")"

satırı tabiki bu şekilde olacak...

 

[1Al2Ver]

e tabi

Kopyalayıp üzerinde değişiklik yapınca bazen böyle hatalar oluşuyor, düzeltmemi ister misiniz?

Sayın Yeşertener, sağolun, ben hallederim, saygılarımla.

 

[1Al2Ver]

Sayın Hocamın izini ile evet ;

Range("G" & Sat) = "=SUM(G4:G" & Sat - 1 & ")"

satırı tabiki bu şekilde olacak...

Sayın ECYAvuz, ilginiz için teşekkür ederim, saygılarımla.