Excel Forum

Excel Forum (http://www.excel.web.tr/index.php)
-   Makro-VBA (http://www.excel.web.tr/forumdisplay.php?f=48)
-   -   Belirli tarihten sonra boş satır eklemek. (http://www.excel.web.tr/showthread.php?t=170401)

sinan05 08-02-2018 11:02

Belirli tarihten sonra boş satır eklemek.
 
Herkese hayırlı günler, iyi çalışmalar dilerim. Hocalarım uygunsa eğer bir yardımınızı rica edicem. Makrodan anlamıyorum, burdan ve netten araştırdığım kadarıyla bir makro oluşturmaya çalıştım. Amacım; çalışma dosyamın A sütununda tarihler var, A ve K hücreleri arasında değerler var. Aşağıya eklemiş olduğum makro ile A sütununda bulunan tarihler arasında ayın 5 inden sonra A:K arasında bir satır boşluk bıraksın. Aşağıdaki klemiş olduğum makro ile buna birazcık yaklaştım sanki. Fakat şöyle sorunlar çıktı, A1 hücresinden sonra sürekli boş satır ekliyor makro durmuyor, kısır bir döngüye girdi vede sadece 1 hücre boş ekliyor ben istiyorum ki A:K aralığı kadar boş satır eklesin. Yardımcı olabilirseniz çok sevinirim.

Sub bos_satir_eklemek()
Dim Excel As Range
Dim Makro As Integer
For Each Excel In Range("A2:A1000")
Excel.Value = Makro
Makro = 5 / 2 / 2018
If Makro = Excel Then
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
End If
Next Excel
End Sub

YUSUF44 08-02-2018 11:13

Aşağıdaki makroyu deneyin:

Kod:

Sub satırekle()
For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If Cells(i, "A") <> "" Then
        If IsDate(Cells(i, "A")) = True Then
            If Day(Cells(i, "A")) = 5 Then
                Rows(i + 1).Insert shift:=xlDown
            End If
        End If
    End If
Next
End Sub


sinan05 08-02-2018 11:30

Alıntı:

YUSUF44 tarafından gönderildi (Mesaj 929502)
Aşağıdaki makroyu deneyin:

Kod:

Sub satırekle()
For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If Cells(i, "A") <> "" Then
        If IsDate(Cells(i, "A")) = True Then
            If Day(Cells(i, "A")) = 5 Then
                Rows(i + 1).Insert shift:=xlDown
            End If
        End If
    End If
Next
End Sub


Yusuf Hocam dönüşünüz ve yardımınız için çok teşekkür ederim, eksik olmayın. Fakat A sütununda ayın 5 ine birden fazla veri var yani bazı zamanlar 05.02.2018 tarihinden 5 tane bazende 8 veya daha fazla veri olabailiyor. Yani tam olarak istediğim bu 5 ne olan tarihlerin en sonuncusundan sonra boş satır bırakmak birde sadece A:K arasını içerecek şekilde boş satır eklemek çünkü L ve sonrasındaki sütunlarda da değer var bu değerler etkileniyor hocam. Son olarak mümkünse eğer 5,10,15,20.25 ve 30 tarihlerinden sonra da bir boş satır eklenebilirse çok sevinirim.

YUSUF44 08-02-2018 14:08

Sorunuzu örnek dosya olmadan çözmek zor maalesef. Bir örnek dosya paylaşın ne ne istediğinizi açık olarak anlatın. Sonuncudan kastınız nedir belli olmuyor. Ona da örnekle açıklama yapın lütfen.

sinan05 08-02-2018 14:24

Alıntı:

YUSUF44 tarafından gönderildi (Mesaj 929529)
Sorunuzu örnek dosya olmadan çözmek zor maalesef. Bir örnek dosya paylaşın ne ne istediğinizi açık olarak anlatın. Sonuncudan kastınız nedir belli olmuyor. Ona da örnekle açıklama yapın lütfen.

http://s7.dosya.tc/server2/48x0zz/ornek_resim.rar.html

Hocam dosyam çok karışık olduğu için ekleyemedim mazur görünüz. Yukarıdaki linke 2 resim ekledim. Her iki resimde de 05.02.2018 tarihli 2 adet veri var. sizin makronuzu çalıştırdığımda Örnek1 de görüleceği gibi 05.02.2018 tarihli her hücreden sonra boş satır eklemiş. Benim istediğim ise örnek2 de ki gibi en sonuncu 05.02.2018 tarihli veriden sonra boşluk bırakması.

YUSUF44 08-02-2018 15:02

Aşağıdaki gibi deneyin:

Kod:

Sub Makro1()
'
' Makro1 Makro
'

'
    Range("A29:K29").Select
    Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub
Sub satırekle()
For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If Cells(i, "A") <> "" Then
        If IsDate(Cells(i, "A")) = True Then
            If Day(Cells(i, "A")) = 5 Then
                Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                i = 1
            End If
        End If
    End If
Next

For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If Cells(i, "A") <> "" Then
        If IsDate(Cells(i, "A")) = True Then
            If Day(Cells(i, "A")) = 10 Then
                Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                i = 1
            End If
        End If
    End If
Next

For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If Cells(i, "A") <> "" Then
        If IsDate(Cells(i, "A")) = True Then
            If Day(Cells(i, "A")) = 15 Then
                Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                i = 1
            End If
        End If
    End If
Next

For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If Cells(i, "A") <> "" Then
        If IsDate(Cells(i, "A")) = True Then
            If Day(Cells(i, "A")) = 20 Then
                Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                i = 1
            End If
        End If
    End If
Next

For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If Cells(i, "A") <> "" Then
        If IsDate(Cells(i, "A")) = True Then
            If Day(Cells(i, "A")) = 25 Then
                Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                i = 1
            End If
        End If
    End If
Next

For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If Cells(i, "A") <> "" Then
        If IsDate(Cells(i, "A")) = True Then
            If Day(Cells(i, "A")) = 30 Then
                Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                i = 1
            End If
        End If
    End If
Next


End Sub

Bu arada örnek dosya olarak asıl dosyanızı göndermenizi istemiyor ve beklemiyoruz. İstediğimiz, ne istediğinizi tam olarak gösteren asıl dosyanızla birebir aynı yapıda olan küçük bir örnek. İçinde gerçek veriler olması gerekmiyor.

sinan05 08-02-2018 15:23

Alıntı:

YUSUF44 tarafından gönderildi (Mesaj 929534)
Aşağıdaki gibi deneyin:

Kod:

Sub Makro1()
'
' Makro1 Makro
'

'
    Range("A29:K29").Select
    Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub
Sub satırekle()
For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If Cells(i, "A") <> "" Then
        If IsDate(Cells(i, "A")) = True Then
            If Day(Cells(i, "A")) = 5 Then
                Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                i = 1
            End If
        End If
    End If
Next

For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If Cells(i, "A") <> "" Then
        If IsDate(Cells(i, "A")) = True Then
            If Day(Cells(i, "A")) = 10 Then
                Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                i = 1
            End If
        End If
    End If
Next

For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If Cells(i, "A") <> "" Then
        If IsDate(Cells(i, "A")) = True Then
            If Day(Cells(i, "A")) = 15 Then
                Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                i = 1
            End If
        End If
    End If
Next

For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If Cells(i, "A") <> "" Then
        If IsDate(Cells(i, "A")) = True Then
            If Day(Cells(i, "A")) = 20 Then
                Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                i = 1
            End If
        End If
    End If
Next

For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If Cells(i, "A") <> "" Then
        If IsDate(Cells(i, "A")) = True Then
            If Day(Cells(i, "A")) = 25 Then
                Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                i = 1
            End If
        End If
    End If
Next

For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If Cells(i, "A") <> "" Then
        If IsDate(Cells(i, "A")) = True Then
            If Day(Cells(i, "A")) = 30 Then
                Range("A" & i + 1 & ":K" & i + 1).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                i = 1
            End If
        End If
    End If
Next


End Sub

Bu arada örnek dosya olarak asıl dosyanızı göndermenizi istemiyor ve beklemiyoruz. İstediğimiz, ne istediğinizi tam olarak gösteren asıl dosyanızla birebir aynı yapıda olan küçük bir örnek. İçinde gerçek veriler olması gerekmiyor.

Yusuf Hocam çok çok çok teşekkür ederim. Siz fevkalade mübarek bir şahsiyetsiniz Allah razı olsun eksik olmayın müthiş yapmışsınız. Hocam haklısınız ben o an düşünemedim küçük bir örneğini koymalıydım hiç aklıma gelmedi ama inanın aklımda başka bişey düşünmemiştim, yani dosyam çok yoğun ve boyutu büyük ayrıca açılışta otomatik uzun sorgular yapıyor affediniz beni. Emeğinize yüreğinize sağlık siz harikasınız.
Birde hocam son olarak elimde şöyle bir makro var.

Sub Veriler_Yeniler_Bakiyeler()
Application.ScreenUpdating = False
Dim S1 As Worksheet, S2 As Worksheet, Defterler(), Son As Long, Satır As Long
Worksheets("Sayfa1").Range("a2:K65536").ClearConte nts
Set S1 = Sheets("Sayfa1")
Defterler = Array("VERİLER")

Satır = 3

For Each defter In Defterler
Set S2 = Sheets(defter)
Son = S2.Cells(S2.Rows.Count, 1).End(3).Row
For x = 2 To Son
If S2.Cells(x, "B") = Worksheets("Sayfa1").Range("M16") Then
S2.Range("A" & x & ":K" & x).Copy S1.Cells(Satır, 1)
Satır = Satır + 1
End If
Next
Satır = Satır + 1
Next

İşte bu makronun getirdiği verileri sizin makronuz gruplara ayırıp arada boşluk bırakıyor. Acaba sizin makronuzla bunu birleştirmenin yolu var mı, hani ikisini ayrı ayrı çalıştırmasak hocam. Affınıza mahçuben yazıyorum sizi sıktıysam kusuruma bakmayın.

YUSUF44 08-02-2018 15:32

İlk makronun son satırından önce benim verdiğim kodları (ilk ve son satırlar olmadan) ekleyebilirsiniz ya da Call Makro1 diyerek benim verdiğim makronun çalıştırılmasını sağlayabilirsiniz:

Kod:

Sub Veriler_Yeniler_Bakiyeler()
.
.
Sizin kodlarınız
..

benim kodlarım (Sub ve End sub satırları hariç)
..
End sub

Ya da

Kod:

Sub Veriler_Yeniler_Bakiyeler()
.
.
Sizin kodlarınız
..

Call Makro1

End Sub

gibi.

sinan05 08-02-2018 15:38

Alıntı:

YUSUF44 tarafından gönderildi (Mesaj 929541)
İlk makronun son satırından önce benim verdiğim kodları (ilk ve son satırlar olmadan) ekleyebilirsiniz ya da Call Makro1 diyerek benim verdiğim makronun çalıştırılmasını sağlayabilirsiniz:

Kod:

Sub Veriler_Yeniler_Bakiyeler()
.
.
Sizin kodlarınız
..

benim kodlarım (Sub ve End sub satırları hariç)
..
End sub

Ya da

Kod:

Sub Veriler_Yeniler_Bakiyeler()
.
.
Sizin kodlarınız
..

Call Makro1

End Sub

gibi.


Hocam iki önerinizide daha önceki makrolara uygulamıştım, acaba daha hızlı bir yöntem olabilirmi diye düşündüm zira siz büyük profesyonel hocalar en iyisini bilirsiniz. Eğer en hızlı yöntem bunlarsa siz uygun görüyorsanız ilk seçeneği uyguluyacam. Ayrıca namazdan sonra sizin içinde dua edicem emeğiniz ve uğraştığınız için tekrar tekrar teşekkürler hocam. Saygılarımı sunarım Yusuf hocam Allaha emenet olunuz.

sinan05 10-02-2018 16:04

Hocam hayırlı günler. Kusuruma bakmazsanız rahatsız etmezsem bişey sorabilirmiyim. Çünkü kendim yapmaya çalışıyorum olmuyor. Bana boş satır ekleyen son yaptığınız makroda eklenen boş satırın 2. hücresine bir değer yazmak istiyorum Nette araştırdım şunu yapabildim;
sat = Cells(1, "A").End(xlDown).Row + 1
Cells(sat, 2).Select
ActiveCell.FormulaR1C1 = "AYIN 10 NE OLAN TAKSİTLER"
ama ben her eklenen boş satıra farklı değer yazacağım. acaba bunun çözümü varmı Hocam.


Saat 11:54

Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.