Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 08-02-2018, 10:02   #1
sinan05
 
Giriş: 16/11/2017
Şehir: istanbul
Mesaj: 116
Excel Vers. ve Dili:
Excel 2016 Türkçe
Varsayılan 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
sinan05 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-02-2018, 10:13   #2
YUSUF44
Destek Ekibi
 
YUSUF44 kullanıcısının avatarı
 
Giriş: 04/01/2006
Şehir: Manisa, Kula
Mesaj: 6,708
Excel Vers. ve Dili:
İş : Ofis 2016 - Türkçe Ev: Ofis 2016 - Türkçe
Varsayılan

Aşağıdaki makroyu deneyin:

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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
__________________


Sorularınızı örnek dosyayla desteklemeniz çözüme ulaşmanızı kolaylaştırır.

Altın Üye olmanızı öneririm. Altın Üye değilseniz dosyanızı dosya yükleme sitelerinden birine yükleyip linkini paylaşabilirsiniz.
YUSUF44 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-02-2018, 10:30   #3
sinan05
 
Giriş: 16/11/2017
Şehir: istanbul
Mesaj: 116
Excel Vers. ve Dili:
Excel 2016 Türkçe
Varsayılan

Alıntı:
YUSUF44 tarafından gönderildi Mesajı Görüntüle
Aşağıdaki makroyu deneyin:

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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.
sinan05 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-02-2018, 13:08   #4
YUSUF44
Destek Ekibi
 
YUSUF44 kullanıcısının avatarı
 
Giriş: 04/01/2006
Şehir: Manisa, Kula
Mesaj: 6,708
Excel Vers. ve Dili:
İş : Ofis 2016 - Türkçe Ev: Ofis 2016 - Türkçe
Varsayılan

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.
__________________


Sorularınızı örnek dosyayla desteklemeniz çözüme ulaşmanızı kolaylaştırır.

Altın Üye olmanızı öneririm. Altın Üye değilseniz dosyanızı dosya yükleme sitelerinden birine yükleyip linkini paylaşabilirsiniz.
YUSUF44 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-02-2018, 13:24   #5
sinan05
 
Giriş: 16/11/2017
Şehir: istanbul
Mesaj: 116
Excel Vers. ve Dili:
Excel 2016 Türkçe
Varsayılan

Alıntı:
YUSUF44 tarafından gönderildi Mesajı Görüntüle
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ı.
sinan05 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-02-2018, 14:02   #6
YUSUF44
Destek Ekibi
 
YUSUF44 kullanıcısının avatarı
 
Giriş: 04/01/2006
Şehir: Manisa, Kula
Mesaj: 6,708
Excel Vers. ve Dili:
İş : Ofis 2016 - Türkçe Ev: Ofis 2016 - Türkçe
Varsayılan

Aşağıdaki gibi deneyin:

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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.
__________________


Sorularınızı örnek dosyayla desteklemeniz çözüme ulaşmanızı kolaylaştırır.

Altın Üye olmanızı öneririm. Altın Üye değilseniz dosyanızı dosya yükleme sitelerinden birine yükleyip linkini paylaşabilirsiniz.
YUSUF44 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-02-2018, 14:23   #7
sinan05
 
Giriş: 16/11/2017
Şehir: istanbul
Mesaj: 116
Excel Vers. ve Dili:
Excel 2016 Türkçe
Varsayılan

Alıntı:
YUSUF44 tarafından gönderildi Mesajı Görüntüle
Aşağıdaki gibi deneyin:

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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.
sinan05 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-02-2018, 14:32   #8
YUSUF44
Destek Ekibi
 
YUSUF44 kullanıcısının avatarı
 
Giriş: 04/01/2006
Şehir: Manisa, Kula
Mesaj: 6,708
Excel Vers. ve Dili:
İş : Ofis 2016 - Türkçe Ev: Ofis 2016 - Türkçe
Varsayılan

İ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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Veriler_Yeniler_Bakiyeler()
.
.
Sizin kodlarınız
..

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

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Veriler_Yeniler_Bakiyeler()
.
.
Sizin kodlarınız
..

Call Makro1

End Sub
gibi.
__________________


Sorularınızı örnek dosyayla desteklemeniz çözüme ulaşmanızı kolaylaştırır.

Altın Üye olmanızı öneririm. Altın Üye değilseniz dosyanızı dosya yükleme sitelerinden birine yükleyip linkini paylaşabilirsiniz.
YUSUF44 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 08-02-2018, 14:38   #9
sinan05
 
Giriş: 16/11/2017
Şehir: istanbul
Mesaj: 116
Excel Vers. ve Dili:
Excel 2016 Türkçe
Varsayılan

Alıntı:
YUSUF44 tarafından gönderildi Mesajı Görüntüle
İ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: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub Veriler_Yeniler_Bakiyeler()
.
.
Sizin kodlarınız
..

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

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
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 Çevrimdışı   Alıntı Yaparak Cevapla
Eski 10-02-2018, 15:04   #10
sinan05
 
Giriş: 16/11/2017
Şehir: istanbul
Mesaj: 116
Excel Vers. ve Dili:
Excel 2016 Türkçe
Varsayılan

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.
sinan05 Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 05:13


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım -- Beylikdüzü mali müşavir - Beylikdüzü mali müşavir - Lingerie - Dyeing Machine - Karton Bardak- Karton Bardak- Çorlu Dil Konuşma Terapisti- Çorlu Dil Konuşma Terapisti- Çorlu Konuşma Terapisti- Çorlu Konuşma Terapisti- Çorlu Özel Eğitim- Site Yönetimi- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Çorlu- Çorlu Araç Takip- Rampa- Çorlu İnternet Sitesi- Çorlu Sürücü Kursu- Şişli Avukat- Çorlu Etüt- İstanbul Botanik- Çorlu Sigorta- Kağıt Bardak- Kağıt Bardak- Çorlu Havuz- Çorlu Havuz- Çorlu Perde Yıkama- Okul Danışmanlık- ADR'li taşıma kabı imalatı- Mekanik Tesisat- Çorlu Grafik Tasarım- Çorlu Sondaj- Çorlu Etüt- Futbol Cafe- Beylikdüzü Temizlik- Çorlu Kurs- Çorlu Ders- İzmit Mimar- Hurda Bakır Kablo- Hurda Bakır Kablo- Çorlu Pronet- Çorlu Yönetim- Çorlu Apartman Yönetimi- Çorlu Marangoz- Çorlu Avukat- Çorlu Su Arıtma- Çorlu Kompresör- İstanbul İnşaat-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden