[Çözüldü] Satır Ekleme ve Silme Formül Sorunu

[muhittinemmi]

Merhaba aşağıdaki kodda yeni satır eklendiğinde formül eklenmiyor

sabit olarak bulunan; F5 Hücresindeki =EĞER(E5<>"";C5*E5;"") ve G5 hücrsindeki =EĞER(E5<>"";M5;"") fomülünü

eklenen satıra otomatik olarak ekleye bilmek için nasıl bir değişiklik yapmak gerekir.

Kod: Tümünü seç

Sub Ekle()
Dim i As Integer
s = Sheets("Teklif").[H65536].End(3).Row
Sheets("Teklif").Range("B" & s & ":H" & s).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
For i = 5 To s
Top = Top + (Sheets("Teklif").Range("H" & i) * Sheets("Teklif").Range("H" & i))
Next i
If Top = 0 Then Exit Sub
Sheets("Teklif").Range("H" & s + 1) = Round(Top, 2)
End Sub

Sub Sil()
Dim i, s As Integer
s = Sheets("Teklif").[H65536].End(3).Row - 1
If s = 5 Then MsgBox "SİLİNECEK SATIR YOK", vbInformation, "BİLGİ": Exit Sub
Sheets("Teklif").Range("B" & s & ":H" & s).Delete Shift:=xlUp
For i = 5 To s - 1
Top = Top + (Sheets("Teklif").Range("H" & i) * Sheets("Teklif").Range("H" & i))
Next i
If Top = 0 Then Exit Sub
Sheets("Teklif").Range("B" & s) = Round(Top, 2)
End Sub

Sub Sıfırla()
Dim i, s As Integer
s = Sheets("Teklif").[H65536].End(3).Row
If s > 6 Then Sheets("Teklif").Range("B6:H" & s - 1).Delete Shift:=xlUp

End Sub

[muhittinemmi]

Yabancı platform aracılığı ile problem çözümünü buldum.

Site değişimi güzel olmuş fakat veri tabanındaki konularda eklenebilseydi çok güzel olurdu. Büyük bir kaybımız var.

Örnek olması açısından çözümü ekliyorum
Sub Ekle bölümü aşağıdaki gibi değiştirildiğinde geyet güzel çalışıyor.

Kod: Tümünü seç

Sub Ekle()
Dim i As Integer
s = Sheets("Teklif").[H65536].End(3).Row
Sheets("Teklif").Range("B" & s & ":H" & s).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
For i = 5 To s
Top = Top + (Sheets("Teklif").Range("H" & i) * Sheets("Teklif").Range("H" & i))
Sheets("Teklif").Cells(i, "F").Formula = "=IF(E" & i & "<>"""",C" & i & "*E" & i & " ,"""")"
Sheets("Teklif").Cells(i, "G").Formula = "=IF(E" & i & "<>"""",M" & i & ","""")"
Next i
If Top = 0 Then Exit Sub
Sheets("Teklif").Range("H" & s + 1) = Round(Top, 2)
End Sub

[Tarkan VURAL]

Site değişimi güzel olmuş fakat veri tabanındaki konularda eklenebilseydi çok güzel olurdu. Büyük bir kaybımız var.

Merhaba,
Eski alt yapının yenisine uyarlanabilmesi konusunda hosting tarafında bir takım sıkıntılar var. Çözmeye çalışılıyor.

[muhittinemmi]

Merhaba Tarkan Bey

Command Buton ile yapıldığında sıkıntı yok
Private Sub CommandButton4_Click()
ActiveSheet.Unprotect "123"
Call Ekle
ActiveSheet.Protect "123"
End Sub




Düğme ye makro atayıp aşağıdaki gibi kullandığımda sayfa koruması açılıyor fakat işlem bittiğinde sayfa koruması kapanmıyor
ActiveSheet.Unprotect ve ActiveSheet.protect i yanlışmı uyguluyorum acaba.


Örnek:

Kod: Tümünü seç

Sub Ekle()
ActiveSheet.Unprotect "123" 
Dim i As Integer
s = Sheets("Teklif").[H65536].End(3).Row
Sheets("Teklif").Range("B" & s & ":H" & s).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
For i = 5 To s
Top = Top + (Sheets("Teklif").Range("H" & i) * Sheets("Teklif").Range("H" & i))
Sheets("Teklif").Cells(i, "F").Formula = "=IF(E" & i & "<>"""",C" & i & "*E" & i & " ,"""")"
Sheets("Teklif").Cells(i, "G").Formula = "=IF(E" & i & "<>"""",M" & i & ","""")"
Next i
If Top = 0 Then Exit Sub
Sheets("Teklif").Range("H" & s + 1) = Round(Top, 2)
End Sub
ActiveSheet.protect "123" 

[Tarkan VURAL]

End sub kısmından sonraya eklemeniz doğru değil. Zaten orada hata vermesi gerekir. İçeriye alınız.

Bu arada önceki siteyi de içerik olarak yayına aldık. Üst menülerdeki Eski Forum kısmından erişilebilir durumda. Bilginize.

[muhittinemmi]

Bilgi için teşekkürler konuları inceleyeceğim.

Sayfa korumasını kaldırıyor fakat işlem bitince kilitleme işlemini yapmıyor

Kod: Tümünü seç

Sub Ekle()
ActiveSheet.Unprotect "123" 
Dim i As Integer
s = Sheets("Teklif").[H65536].End(3).Row
Sheets("Teklif").Range("B" & s & ":H" & s).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
For i = 5 To s
Top = Top + (Sheets("Teklif").Range("H" & i) * Sheets("Teklif").Range("H" & i))
Sheets("Teklif").Cells(i, "F").Formula = "=IF(E" & i & "<>"""",C" & i & "*E" & i & " ,"""")"
Sheets("Teklif").Cells(i, "G").Formula = "=IF(E" & i & "<>"""",M" & i & ","""")"
Next i
If Top = 0 Then Exit Sub
Sheets("Teklif").Range("H" & s + 1) = Round(Top, 2)
ActiveSheet.protect "123" 
End Sub

[Tarkan VURAL]

Kod: Tümünü seç

If Top = 0 Then Exit Sub

Bu satırdan sonra muhtemelen çıkış yapıyor. Koruma kod satırını bu satırdan bir önceye taşıyın.

[muhittinemmi]

Teşekkürler çalıştı.