Veriler arasında tarihe göre boşluk bırakmak

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Veriler arasında tarihe göre boşluk bırakmak

İleti#1)  sinan05 » 21 Haz 2019 11:11

İyi günler herkese hayırlı cumalar dilerim. Aşağıdaki makro Anasayfada A1 hücresinde yazan veriyi, kayıtlar sayfasında A:U arası aratıp bulduğu satırın A:U arasını kopyalayıp Anasayfa A:U arasına yapıştırıyor. her iki sayfanın taslağı aynı. A sütununda tarihler var. makro verileri anasayfaya getirdikten sonra her kopyaladığı veriden sonra tarihler arası boşluk bırakabilirmi. Yani 10.01.2017 den 2 satır veri getirdi sonra bir satır boş kalacak, 12.01.2017 tarihli 3 satır veri getirdi bir satır boş bırakacak burda hangi tarihten kaç tane veri olduğu belirsiz aynı tarihten 1 satır veri de olabilir 5 satırda. Makroyu bu şekilde revize edebilirseniz çok sevinicem şimdiden teşekkürler.

Sub isme_Gore_Veri_Getir_Hizli()
Application.ScreenUpdating = False
Dim S1 As Worksheet, S2 As Worksheet
Dim Bul As Range, Adres As String, Satir As Long, Say As Long
Set S1 = Sheets("ANA SAYFA")
Set S2 = Sheets("KAYITLAR")
S1.Range("A4:U" & S1.Rows.Count).ClearContents

Aranan = S1.Range("A1").Value
Set Bul = S2.Range("A:U").Find(Aranan, , , xlPart)
If Not Bul Is Nothing Then
Adres = Bul.Address
Do
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row + 1
S1.Range("A" & Satir & ":U" & Satir).Value = S2.Range("A" & Bul.Row & ":U" & Bul.Row).Value
Say = Say + 1
Set Bul = S2.Range("A:U").FindNext(Bul)
Loop While Not Bul Is Nothing And Bul.Address <> Adres
End If
Set Bul = Nothing
Set S1 = Nothing
Set S2 = Nothing
Application.ScreenUpdating = True
Sheets("ANA SAYFA").Select
Range("A4").Select
End Sub
Kullanıcı avatarı
sinan05
Siteye Alışmış
 
Kayıt: 25 Arl 2017 19:37
Meslek: ticari-binek oto alım satım.
Yaş: 36
İleti: 155
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: istanbul-bakırköy

Cevap: Veriler arasında tarihe göre boşluk bırakmak

İleti#2)  ahmetilhan282 » 21 Haz 2019 21:01

Kodlardaki şu satırda en son da bulunan + 1 yerine + 2 yazıp deneyin
Kod: Tümünü seç
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row + 1

Kod: Tümünü seç
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row + 2
Kullanıcı avatarı
ahmetilhan282
Site Dostu
 
Adı Soyadı:Ahmet İLHAN
Kayıt: 15 Oca 2014 00:04
Konum: Adana
Meslek: Güvenlik
Yaş: 29
İleti: 838
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Mersin

Cevap: Cevap: Veriler arasında tarihe göre boşluk bırakmak

İleti#3)  sinan05 » 21 Haz 2019 23:05

ahmetilhan282 yazdı:Kodlardaki şu satırda en son da bulunan + 1 yerine + 2 yazıp deneyin
Kod: Tümünü seç
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row + 1

Kod: Tümünü seç
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row + 2


Ahmet hocam teşekkü ederim ilginize fakat öyle denemiştim istediğim gibi olmuyor malesef. o şekilde her satır arası bir boşluk bırakıyor benim istediğim aynı tarihleri gruplaması. 01.02.2017 den 2 tane veri varsa ikisi alt alta olcak sonra bir satır boş olcak.3 tane varsa 3.den sonra boşluk olcak.
Kullanıcı avatarı
sinan05
Siteye Alışmış
 
Kayıt: 25 Arl 2017 19:37
Meslek: ticari-binek oto alım satım.
Yaş: 36
İleti: 155
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: istanbul-bakırköy

Cevap: Veriler arasında tarihe göre boşluk bırakmak

İleti#4)  ahmetilhan282 » 22 Haz 2019 20:47

Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row + 2
satırını do ... loop döngüsünün üstüne taşıyın.
göründüğü kadarıyla bir işe yaramayan say = say +1 satırını da Satir = Satir +1 olarak değiştirin.
son hali şöyle olmalı
Kod: Tümünü seç
Sub isme_Gore_Veri_Getir_Hizli()
Application.ScreenUpdating = False
Dim S1 As Worksheet, S2 As Worksheet
Dim Bul As Range, Adres As String, Satir As Long, Say As Long
Set S1 = Sheets("ANA SAYFA")
Set S2 = Sheets("KAYITLAR")
S1.Range("A4:U" & S1.Rows.Count).ClearContents

Aranan = S1.Range("A1").Value
Set Bul = S2.Range("A:U").Find(Aranan, , , xlPart)
If Not Bul Is Nothing Then
Adres = Bul.Address
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row + 2
Do
S1.Range("A" & Satir & ":U" & Satir).Value = S2.Range("A" & Bul.Row & ":U" & Bul.Row).Value
Satir = Satir + 1
Set Bul = S2.Range("A:U").FindNext(Bul)
Loop While Not Bul Is Nothing And Bul.Address <> Adres
End If
Set Bul = Nothing
Set S1 = Nothing
Set S2 = Nothing
Application.ScreenUpdating = True
Sheets("ANA SAYFA").Select
Range("A4").Select
End Sub

eğer istediğiniz gibi olmadıysa örnek dosyanızı yükleyebilir misiniz?
Kullanıcı avatarı
ahmetilhan282
Site Dostu
 
Adı Soyadı:Ahmet İLHAN
Kayıt: 15 Oca 2014 00:04
Konum: Adana
Meslek: Güvenlik
Yaş: 29
İleti: 838
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Mersin

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Cevap: Veriler arasında tarihe göre boşluk bırakmak

İleti#5)  sinan05 » 23 Haz 2019 11:49

ahmetilhan282 yazdı:Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row + 2
satırını do ... loop döngüsünün üstüne taşıyın.
göründüğü kadarıyla bir işe yaramayan say = say +1 satırını da Satir = Satir +1 olarak değiştirin.
son hali şöyle olmalı
Kod: Tümünü seç
Sub isme_Gore_Veri_Getir_Hizli()
Application.ScreenUpdating = False
Dim S1 As Worksheet, S2 As Worksheet
Dim Bul As Range, Adres As String, Satir As Long, Say As Long
Set S1 = Sheets("ANA SAYFA")
Set S2 = Sheets("KAYITLAR")
S1.Range("A4:U" & S1.Rows.Count).ClearContents

Aranan = S1.Range("A1").Value
Set Bul = S2.Range("A:U").Find(Aranan, , , xlPart)
If Not Bul Is Nothing Then
Adres = Bul.Address
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row + 2
Do
S1.Range("A" & Satir & ":U" & Satir).Value = S2.Range("A" & Bul.Row & ":U" & Bul.Row).Value
Satir = Satir + 1
Set Bul = S2.Range("A:U").FindNext(Bul)
Loop While Not Bul Is Nothing And Bul.Address <> Adres
End If
Set Bul = Nothing
Set S1 = Nothing
Set S2 = Nothing
Application.ScreenUpdating = True
Sheets("ANA SAYFA").Select
Range("A4").Select
End Sub

eğer istediğiniz gibi olmadıysa örnek dosyanızı yükleyebilir misiniz?


Ahmet hocam çok teşekkür ederim sağolun çeşitli şartlarda test edip deniyorum eksik olmayın. Testlerden sonra dönüş yapacağım.
Kullanıcı avatarı
sinan05
Siteye Alışmış
 
Kayıt: 25 Arl 2017 19:37
Meslek: ticari-binek oto alım satım.
Yaş: 36
İleti: 155
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: istanbul-bakırköy

Cevap: Cevap: Veriler arasında tarihe göre boşluk bırakmak

İleti#6)  sinan05 » 23 Haz 2019 12:09

ahmetilhan282 yazdı:Kodlardaki şu satırda en son da bulunan + 1 yerine + 2 yazıp deneyin
Kod: Tümünü seç
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row + 1

Kod: Tümünü seç
Satir = S1.Cells(S1.Rows.Count, 1).End(3).Row + 2


AHMET Hocam ordamısınız, bişey sorabilirmiyim.
Kullanıcı avatarı
sinan05
Siteye Alışmış
 
Kayıt: 25 Arl 2017 19:37
Meslek: ticari-binek oto alım satım.
Yaş: 36
İleti: 155
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: istanbul-bakırköy

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Cevap: Cevap: Veriler arasında tarihe göre boşluk bır

İleti#7)  ahmetilhan282 » 23 Haz 2019 20:37

sinan05 yazdı:AHMET Hocam orda mısınız, bişey sorabilir miyim.

ara ara buralardayım. sorabilirsiniz.
Kullanıcı avatarı
ahmetilhan282
Site Dostu
 
Adı Soyadı:Ahmet İLHAN
Kayıt: 15 Oca 2014 00:04
Konum: Adana
Meslek: Güvenlik
Yaş: 29
İleti: 838
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Mersin

Cevap: Cevap: Cevap: Cevap: Veriler arasında tarihe göre boş

İleti#8)  sinan05 » 25 Haz 2019 11:15

ahmetilhan282 yazdı:
sinan05 yazdı:AHMET Hocam orda mısınız, bişey sorabilir miyim.

ara ara buralardayım. sorabilirsiniz.

Sağolun Ahmet Hocam. Aşağıya eklediğim makro dolu olan hücreleri kopyalıyor. A sutununda tarihler var. Benim istediğim acaba dolu olan satır yerine sadece hangi gündeysek o günün tarihine uyan A:U arası satırları seçebilirmi. Sadece seçsin kopyalama başka bişey yapmasın. Çünkü ben ona daha sonra başka işlevler ekleyeceğim. Şimdiden teşekkürler.
Kullanıcı avatarı
sinan05
Siteye Alışmış
 
Kayıt: 25 Arl 2017 19:37
Meslek: ticari-binek oto alım satım.
Yaş: 36
İleti: 155
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: istanbul-bakırköy

Cevap: Cevap: Cevap: Cevap: Veriler arasında tarihe göre boş

İleti#9)  sinan05 » 25 Haz 2019 11:20

ahmetilhan282 yazdı:
sinan05 yazdı:AHMET Hocam orda mısınız, bişey sorabilir miyim.

ara ara buralardayım. sorabilirsiniz.

Sağolun Ahmet Hocam. Aşağıya eklediğim makro dolu olan hücreleri kopyalıyor. A sutununda tarihler var. Benim istediğim acaba dolu olan satır yerine sadece hangi gündeysek o günün tarihine uyan A:U arası satırları seçebilirmi. Sadece seçsin kopyalama başka bişey yapmasın. Çünkü ben ona daha sonra başka işlevler ekleyeceğim. Şimdiden teşekkürler.

Sub KAYİT_Test()
Application.ScreenUpdating = False
Dim tarih1 As Date, tarih2 As Date, xtarih As Date
Dim S1 As Worksheet, S2 As Worksheet, Defterler(), Son As Long, Satır As Long
Set S1 = Sheets("KAYITLAR")
Defterler = Array("ANA SAYFA")
Satır = 4
For Each defter In Defterler
Set S2 = Sheets(defter)
Son = S2.Cells(S2.Rows.Count, 1).End(3).Row
Son1 = Sheets("KAYITLAR").[a65536].End(3).Row + 1
For x = 4 To Son
If S2.Cells(x, "B").Value <> "" Then
S2.Range("A" & x & ":U" & x).copy
Sheets("KAYITLAR").Cells(Son1, 1).PasteSpecial xlPasteValues
Son1 = Son1 + 1
End If
Next x
Next
Application.ScreenUpdating = True
End Sub
Kullanıcı avatarı
sinan05
Siteye Alışmış
 
Kayıt: 25 Arl 2017 19:37
Meslek: ticari-binek oto alım satım.
Yaş: 36
İleti: 155
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: istanbul-bakırköy

Cevap: Cevap: Cevap: Cevap: Veriler arasında tarihe göre boş

İleti#10)  sinan05 » 25 Haz 2019 18:36

ahmetilhan282 yazdı:
sinan05 yazdı:AHMET Hocam orda mısınız, bişey sorabilir miyim.

ara ara buralardayım. sorabilirsiniz.

Hocam filtreleme yoluyla yaptım çok şükür yardımlarınız için çok teşekkür eserim. Yalnız makroda bir kodu kısaltmam lazım. Benim veriler 4. Satırdan başlıyor. Makro içersinde eğer B sütunundaki hücreler doluysa yanındaki A hücrelerine bugün tarihi atılsın hangi kodlarla yazılır hocam.
Kullanıcı avatarı
sinan05
Siteye Alışmış
 
Kayıt: 25 Arl 2017 19:37
Meslek: ticari-binek oto alım satım.
Yaş: 36
İleti: 155
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: istanbul-bakırköy

Cevap: Cevap: Cevap: Cevap: Cevap: Veriler arasında tarihe g

İleti#11)  ahmetilhan282 » 29 Haz 2019 23:49

sinan05 yazdı:
ahmetilhan282 yazdı:
sinan05 yazdı:AHMET Hocam orda mısınız, bişey sorabilir miyim.

ara ara buralardayım. sorabilirsiniz.

Hocam filtreleme yoluyla yaptım çok şükür yardımlarınız için çok teşekkür eserim. Yalnız makroda bir kodu kısaltmam lazım. Benim veriler 4. Satırdan başlıyor. Makro içersinde eğer B sütunundaki hücreler doluysa yanındaki A hücrelerine bugün tarihi atılsın hangi kodlarla yazılır hocam.


kodlardaki şu kısmı silip:
Kod: Tümünü seç
For x = 4 To Son
If S2.Cells(x, "B").Value <> "" Then
S2.Range("A" & x & ":U" & x).copy
Sheets("KAYITLAR").Cells(Son1, 1).PasteSpecial xlPasteValues
Son1 = Son1 + 1
End If
Next x

bu şekilde deneyin
Kod: Tümünü seç
    For x = 4 To Son
        If S2.Cells(x, "B").Value <> "" Then
            Sheets("KAYITLAR").Cells(Son1, 1) = Format(Now, "dd.mm.yyyy")
            Son1 = Son1 + 1
        End If
    Next x
Kullanıcı avatarı
ahmetilhan282
Site Dostu
 
Adı Soyadı:Ahmet İLHAN
Kayıt: 15 Oca 2014 00:04
Konum: Adana
Meslek: Güvenlik
Yaş: 29
İleti: 838
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Mersin

Cevap: Cevap: Cevap: Cevap: Cevap: Cevap: Veriler arasında t

İleti#12)  sinan05 » 11 Tem 2019 20:50

kodlardaki şu kısmı silip:
Kod: Tümünü seç
For x = 4 To Son
If S2.Cells(x, "B").Value <> "" Then
S2.Range("A" & x & ":U" & x).copy
Sheets("KAYITLAR").Cells(Son1, 1).PasteSpecial xlPasteValues
Son1 = Son1 + 1
End If
Next x

bu şekilde deneyin
Kod: Tümünü seç
    For x = 4 To Son
        If S2.Cells(x, "B").Value <> "" Then
            Sheets("KAYITLAR").Cells(Son1, 1) = Format(Now, "dd.mm.yyyy")
            Son1 = Son1 + 1
        End If
    Next x
[/quote]

Ahmet Hocam geç girebildim siteye çok teşekkür ederim yardımlarınız için, tekrar sağolun.
Kullanıcı avatarı
sinan05
Siteye Alışmış
 
Kayıt: 25 Arl 2017 19:37
Meslek: ticari-binek oto alım satım.
Yaş: 36
İleti: 155
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: istanbul-bakırköy


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: AhrefsBot, Bing[Bot] ve 3 misafir

Bumerang - Yazarkafe