A sütununda değer değişince 3 satır ekle

gcanlar2012 · 13 Nisan 2007

Herkese merhabalar,
Gerçekten 2 saatten beri forumda karşılaştırma ile ilgili yazılanları okudum ama çözüm bulamadım.Onun için yeni konu açtım.

Sorum şu :
A sütununda yaklaşık 500-600 satır bilgi var.Envanterle ilgili bilgiler A sütununda 150.10.001 150.20.001 gibi değerler var,ama 150.10.001 den atıyorum 10 tane var sonra 150.20.001 e geçiyor bu geçişte değer değişince 3 satır eklemek istiyorum.

Şimdiden teşekkürler.

hamitcan · 13 Nisan 2007

Aşağıdaki şekilde dener misiniz?

Kod:

Sub ekle()
For t = [a65536].End(3).Row To 1 Step -1
If Cells(t, 1) <> "" Then
If Cells(t, 1) <> Cells(t + 1, 1) Then
Rows(t + 1 & ":" & t + 3).Insert
End If
End If
Next
End Sub

gcanlar2012 · 13 Nisan 2007

Teşekkür Ederim

Sn.Hamitcan çok teşekkür ederim.Sorumun yanıtı buydu.
Ayrıca bir şey daha sorabilirmiyim.peki arada boşluk varsa onu dikkate almasak.nasıl olur.

gcanlar2012 · 14 Nisan 2007

Sn.Hamitcan Bir önceki mesajımda teşekür ettim,ama bir sorum daha olacak size.Bu yazmış olduğunuz kodda for döngüsünün nasıl çalıştığını anlatırmısınız.Ben bu forumdan çok fazla şey öğrendim ve uyguladım.Olayların mantığını kuruyorum ama uygulamada takılıyorum bu sebeple direk olarak sizin verdiğiniz kodu kullanıp oldu demek istemiyorum öğrenmek anlamında.Yarın başka bir sorunla karşılaşırsam sizin örnekten yola çıkarak gerekli düzeltmeleri yaparak kullanabilirim.Mesala 50 satırlık bir veri var elimde farklı değişkenlerin arasına 3 satır ekledik ama diyelimki 50 satırın içinde 1 veya daha fazla boşluk var onlarada 3 satır ekliyor.2.si [a65536].End(3).Row bunu başa yazmışsınız for bunu başlangıç olarak kabul ediyor işlem a sütunun sonundan mı başlıyor .Kısacası lütfen bu yazdıklarınızın yanına küçük açıklama

Necdet · 14 Nisan 2007

Sayın hamitcan'ın kodlarında küçük bir ekleme yaparak sorununuz çözülülür sanyorum.
Önce A sütununda boş satırları silip sonra araya 3 boş satır eklemek, gereksiz kod yazmayı engeller.

Kod:

Sub ekle()
Range("A1:A" & [A65536].End(3).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
For t = [A65536].End(3).Row To 1 Step -1
If Cells(t, 1) <> "" Then
If Cells(t, 1) <> Cells(t + 1, 1) Then
Rows(t + 1 & ":" & t + 3).Insert
End If
End If
Next
End Sub

Döngünün sondan başlayıp başa gitmesinin nedeni, satır eklendiğinde bulunduğu satırı kaybetmemek içindir.

Baştan başlayıp sona gidilseydi, son satırın numarasını sürekli değiştirmek gerekirdi.

Not : Ben bu kodda Başlık varsa for döngüsündeki to 1 yerine to 2 demek (yada kaç satır başlık varsa, örneğin 2 satır başlık varsa to 3) gerekir.

Kodu biraz kısaltmak gerekirse :

Sub ekle()
Range("A1:A" & [A65536].End(3).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
For i = [A65536].End(3).Row To 2 Step -1
If Cells(i, "A") <> Cells(i + 1, "A") Then
Rows(i + 1 & ":" & i + 3).Insert
End If
Next i
End Sub

gcanlar2012 · 14 Nisan 2007

Sn.Necdet Yesertener yardımlarınız için teşekkür ederim.Ben Sn hamitcanın kodunu şöyle değiştirmiştim.
Sub ekleme()
For t = [a65536].End(3).Row To 1 Step -1
If Cells(t, 1).Value = "" Then
MsgBox "A Sütununda Boş Hücreler Var !!!!"
Exit Sub
End If
If Cells(t, 1) <> Cells(t + 1, 1) Then
Rows(t + 1 & ":" & t + 3).Insert
End If
Next
End Sub
Şimdi neden tersten başladığını anladım amma şu for döngüsündeki .End(3).Row nedemek yani terim olarak.Saçma bir soru ise kusura bakmayın.2 sorum da ben bu kodları kullanma amacım belli ben diyorumki a sütundaki değer değişince 3 boşluk ver ama boşlukları verme amacı altlarına toplam alabilmek.Tabi ben bunu elle yapıyorum.Biraz uğraştım ama beceremedim.Sn.Hamitcanın Kodlarını biraz değiştirdim ama yanlış nerde hatalıyım biraz yardımcı olurmusunuz.
Sub ekle()
atoplam = 0
For t = [a65536].End(3).Row To 1 Step -1
If Cells(t, 1).Value = "" Then
MsgBox "A Sütununda Boş Hücreler var"
Exit Sub
End If
If Cells(t, 1) = Cells(t + 1, 1) Then
atoplam = atoplam + Cells(t, 2)
End If
If Cells(t, 1) <> Cells(t + 1, 1) Then
Rows(t + 1 & ":" & t + 1).Insert
Cells(t + 1, 3) = atoplam
atoplam = 0
End If
Next
End Sub
Şimdiden Teşekkür ederim.

gcanlar2012 · 14 Nisan 2007

Sn.Necdet Yesertener bu arada verdiğiniz kod çalışmadı hata verdi.run time error 424 object required yazdı.son verdiğiniz kod
Sub ekle()
Range("A1:A" & [A65536].End(3).Row).SpecialCells(xlCellTypeBlanks).Entire Row.Delete
For i = [A65536].End(3).Row To 2 Step -1
If Cells(i, "A") <> Cells(i + 1, "A") Then
Rows(i + 1 & ":" & i + 3).Insert
End If
Next i
End Sub

Necdet · 14 Nisan 2007

Merhaba Sayın gcanlar2012,

End(3).Row Son satırı bulmak için kullanılır.

Belli bir sütunda (diyelim A sütununda) son satıra (A65536) gidin ve End + Yukarı Ok tuşuna basın (önce End, sonra yukarı ok tuşu) hareketli nokta (cursor) o satırın en son dolu hücresine gider. Bunun makro karşılığı :

[A65536].end(3).row dur.

Verdiğim örnekte boş satır olmadığı zaman kod hata veriyor, bunu bende sonradan farkettim ve düzelttim, ayrıca biraz daha parametrik olması açısından araya eklenecek boş satır sayısını parametre ile belirlemek istedim.

Kod:

Sub ekle()
    Adet = Application.InputBox("Kaç Satır Eklemek İstiyorsunuz", _
        "Satır Adedi Mesajı", 3, , , , , 1)
On Error GoTo Devam
    Range("A1:A" & [A65536].End(3).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Devam:
    For i = [A65536].End(3).Row To 2 Step -1
        If Cells(i, "A") <> Cells(i + 1, "A") Then
           Rows(i + 1 & ":" & i + Adet).Insert
        End If
    Next i
Toplam = 0
Genel_Toplam = 0
For i = 2 To [A65536].End(3).Row
    If Cells(i, "A") = "" Then
        Cells(i, "A") = "Toplam " & Cells(i - 1, "A")
        Cells(i, "B") = Toplam
        Range(Cells(i, "A"), Cells(i, "B")).Font.Bold = True
        Toplam = 0
        i = i + Adet - 1
    Else
        Toplam = Toplam + Cells(i, "B")
        Genel_Toplam = Genel_Toplam + Cells(i, "B")
    End If
 
Next i
        Cells(i, "A") = "Toplam " & Cells(i - 1, "A")
        Cells(i, "B") = Toplam
        i = i + 1
        Cells(i, "A") = "Genel Toplam"
        Cells(i, "B") = Genel_Toplam
 
        Range(Cells(i - 1, "A"), Cells(i, "B")).Font.Bold = True
 
End Sub

gcanlar2012 · 14 Nisan 2007

Çok Teşekkür ederim inceliyorum.Sağolun.

Necdet · 14 Nisan 2007

Sayın gcanlar2012, dosyayı ve kodları biraz önce yeniledim, tekrar indirip öyle inceleyiniz

gcanlar2012 · 14 Nisan 2007

Sn.Necdet Yesertener ilk yolladığınızda genel toplam hatası vardı herhalde,teşekkür ederim.Anladığım kadarıyla önce boş satırları siliyorsunuz ve benim girdiğim sayı kadar satır ekliyorsunuz.Toplam içinse başlık satırı varmış gibi değerlendirip döngüyü 2 den başlatıp 65536 ya kadar 1 er ara ile bu sefer boş hücreleri kontrol ediyorsunuz.boş olana kadar değerleri topluyorsunuz.sonra ilk boşluğa toplam yazısına bir üsteki değeri ekleyip başlık yapıyoruz .Buraya kadar doğrumuyum.
Yada Zahmet olmazsa bu kodların yanına küçük bir açıklama rica etsem sizden başka soru sormıyacam söz.Gerçekten eğer bu kodları çözemezsem yani anlamazsam uyku uyuyamam.Şimdiden teşekkür ederim.
Çok özür dilerim edit yapıyorum.Birde mükerrer çalışmayı engellesek.yani 2 gere butona tıklarsam bir uyarı tarzında bir şey.

Necdet · 14 Nisan 2007

Sayın gcanlar, bence siz olayı çözmüşsünüz. Üst üste çalıştırma olayını ben size bırakıyorum.

Sizce nasıl bir mantık yürütmeli?

Necdet · 16 Nisan 2007

Ses seda çıkmadı, iki kere çalışmayı önleyen şeklini ekliyorum dosyaya

gcanlar2012 · 16 Nisan 2007

Sn.Necdet Yesertener merhabalar,Öncelikle yardımlarınız için teşekkür ederim.
Cevap yazamadığım için kusura bakmayın.Mesai bitince vba yı bırakıp kaçtım valla.Şimdi sizinde dediğiniz gibi kendim yapmaya çalıştım.Dedimki toplamı aldığı yere bir değişken koyayım atıyorum kont bu değişkene bir değer verip ilk açılışta kontrol edeyim dedim ama olmadı.Bu arada sizin yazmış olduğunuz kodlarda adet sorulan inputbox ta boş bırakınca ve iptal(cancel) tıklayınca hata veriyordu.Nacizane ufak bir değişiklik yaptım kodlar aşağıda.Ama kontrol olayını yapamadım.şimdi sizin son yolladığınız örneği yeni indirdim bakıcam.Tekrar teşekkürler.Cevabın geçikmesi için özür.
birde sizin yadığınız formülü anlamak adına ver seferinde i döngüzünün değeri ve toplamın değerini sayfada bir yere yazdırdım.Çalışma mantığını çözmek için.
Sub ekle()
adet = Application.InputBox("Kaç Satır Eklemek İstiyorsunuz", "Lütfen")
If adet = False Or adet = "" Then
MsgBox "satır eklenemedi", vbInformation, "Üzgünüm"
Exit Sub
End If
On Error GoTo Devam
Range("A1:A" & [a65536].End(3).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Devam:
For i = [a65536].End(3).Row To 2 Step -1
If Cells(i, "A") <> Cells(i + 1, "A") Then
Rows(i + 1 & ":" & i + adet).Insert
End If
Next i
toplam = 0
Genel_Toplam = 0

For i = 2 To [a65536].End(3).Row
If Cells(i, "A") = "" Then
Cells(i, "A") = "Toplam " & Cells(i - 1, "A")
Cells(i, "B") = toplam
Range(Cells(i, "A"), Cells(i, "B")).Font.Bold = True
toplam = 0
i = i + adet - 1
Cells(i - 1, "j") = i
Cells(i - 1, "k") = toplam
Else
toplam = toplam + Cells(i, "B")
Genel_Toplam = Genel_Toplam + Cells(i, "B")
Cells(i - 1, "l") = i
Cells(i - 1, "m") = toplam
End If

Next i
Cells(i - 1, "n") = i
Cells(i - 1, "o") = toplam
Cells(i, "A") = "Toplam " & Cells(i - 1, "A")
Cells(i, "B") = toplam
i = i + 1
Cells(i, "A") = "Genel Toplam"
Cells(i, "B") = Genel_Toplam
Range(Cells(i - 1, "A"), Cells(i, "B")).Font.Bold = True

End Sub

A sütununda değer değişince 3 satır ekle

gcanlar2012

hamitcan

Uzman

gcanlar2012

gcanlar2012

Necdet

Moderatör

gcanlar2012

gcanlar2012

Necdet

Moderatör

gcanlar2012

Necdet

Moderatör

gcanlar2012

Necdet

Moderatör

Necdet

Moderatör

gcanlar2012