satır kopyala, ekle, sil, değiştir işlemlerini; hücredeki miktara göre toplamayı ve çıkarmayı vba ile yapmak

[khthonik]

Merhabalar,

Sanırım yine ilginç bir soruyla karşınızdayım. İlginç ama bir o kadar da işe yarar makrolar çıkartmaya gebe bir soru olduğunu düşünüyorum. Nette araştırdım ama yardımcı olacak kod bulamadım. Nette arayan bulsun faydalı olsun diye, başlıkta özet olarak ifade etmeye çalışsam da... alttaki gibi bir isteğim vardır. Detaylar excelde açıklama olarak yazılmıştır.

Kopyala alta satır ekle: Herhangi bir satırı komple seçtim. Butona bastım. Userform açıldı. Miktar girdim. Tamam a bastım. Seçili satırı kopyalayıp (formüller, açılır pencere ve biçimler dahil) altına satır ekledi. Userforma girdiğim miktarı eklediğim satırın L hücresine yazdı. Farkı da kopyaladığı satırın L hücresine yazdı. Böylelikle satırların toplam miktarı aynı kaldı sadece satır çoğaltmış oldum. Userforma kopyaladığı satırın L hücresindeki sayıdan büyük bir sayı yazılırsa "Talep Miktarından fazla giriş yapılamaz" diye uyarı verdi.

Kopya revizyon yada sil (aslında kopyala alta satır eklenin tersi bir işlemdir): Herhangi bir satırı komple seçtim. Butona bastım. Userform açıldı. Miktar girdim. Tamam a bastım. Userforma girilen sayı silinecek satırın L hücresindeki sayıdan büyük ise "Talep Miktarından fazla silme yapılamaz" diye uyarı versin. Userforma girilen sayı L hücresinden küçük ise girilen sayıyı L hücresine yazsın, farkı benzer olan diğer satırın L hücresine eklesin. Böylelikle satırların toplam miktarı aynı kaldı sadece satır çoğaltmış oldum. Userforma girilen sayı L hücresindeki sayıya eşit ise benzer olan diğer satırın L hücresine eklesin ve seçili satırı silsin. Benzeri yoksa silmesin "Talep komple silinemez" diye uyarı versin. (excelde T sütunu benzersizdir)

Satır ekleme ve silme işlemlerini buton ve userform kullanarak aynı zamanda L sütunundaki miktarlarını girerek yapmak istiyorum. Aynı satırı bir yada birden fazla kopyala satır ekle yapmam gerekebiliyor. xlsx excel indirme linki alttadır.

https://dosya.co/nxqlmlw4j8hu/190811_Giden_İrsaliye_Takip.xlsx.html?killcode=410v86dvk8

Saygılar..

 

[yanginci34]

Dosya gözükmüyor.

 

[khthonik]

190811 Giden İrsaliye Takip.xlsx - 5.4 MB

 

[khthonik]

Merhabalar,

Sorumun cevabı alttaki iki kod kümesi ile çözülmüştür.

Alttaki kod ile seçili satırı kopyalayıp altına ekleyebilirsiniz. Kopyala yapıştır işlemi hücrelerdeki formülleri ve hücre biçimlerini de birebir almaktadır.

Sub KopYap() 'IRSDKM sayfasında seçili satırı kopyala, satır ekle

Application.ScreenUpdating = False
Application.EnableEvents = False
ActiveSheet.Unprotect Password:="***"
    Selection.Copy
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
With Worksheets("IRSDKM")
 .Protect Password:="***", userinterfaceonly:=True, AllowFiltering:=True
 .EnableOutlining = True
 End With
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Alttaki kod ile herhangi bir hücredeki değeri değiştirebilirsiniz.

Sub KopRev() 'IRSDKM sayfasında hücre değeri değiştirme

Application.ScreenUpdating = False
Application.EnableEvents = False
ActiveSheet.Unprotect Password:="***"

Message = "Değer Giriniz"
Title = "Yeni Değer?"
DefaultValue = ""
giris = InputBox(Message, Title, DefaultValue, vbOKCancel)
ActiveCell.Value = giris

With Worksheets("IRSDKM")
 .Protect Password:="***", userinterfaceonly:=True, AllowFiltering:=True
 .EnableOutlining = True
 End With
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

Bu kodlar ile yapılan sayfa koruma, gruplandırma yapmaya müsaade etmektedir.

Saygılar..