Soru Sayfadan sayfaya veri aktarma / kopyalama

[reosman]

Saygıdeğer üstadlarım,

Talep edilen :
"İz" sayfasındaki var olan verilerin tamamını, "İz Arşiv" sayfasına ilk satırına günün tarihini yazarak
mükerrer kayıt kontrolü yaparak son boş satırdan itibaren sadece değer olarak aktarılmasını talep ediyorum.

Yardımlarınızı rica ediyorum.

 

[Korhan Ayhan]

Sicil numarası mükerrer kayıt kontrolü için kullanılmıştır.

Deneyiniz.

Option Explicit

Sub Aktar()
    Dim S1 As Worksheet, S2 As Worksheet, Dizi As Object
    Dim Son As Long, Veri As Variant, X As Long
    Dim Say As Long, Tarih As Double, Zaman As Double
  
    Zaman = Timer
  
    Set S1 = Sheets("İz")
    Set S2 = Sheets("İz Arşiv")
    Set Dizi = CreateObject("Scripting.Dictionary")
  
    Son = S2.Cells(S2.Rows.Count, 1).End(3).Row
    If Son < 3 Then Son = 3
  
    Veri = S2.Range("A2:F" & Son).Value
  
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 4) <> "" Then
            Dizi.Item(Veri(X, 4)) = 1
        End If
    Next
  
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son < 3 Then Son = 3
  
    Veri = S1.Range("A2:F" & Son).Value
  
    ReDim Liste(1 To Ubound(Veri, 1), 1 To 6)
  
    Tarih = Now
  
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Not Dizi.Exists(Veri(X, 4)) Then
            Say = Say + 1
            Liste(Say, 1) = Veri(X, 1)
            Liste(Say, 2) = Veri(X, 2)
            Liste(Say, 3) = Veri(X, 3)
            Liste(Say, 4) = Veri(X, 4)
            Liste(Say, 5) = Veri(X, 5)
            Liste(Say, 6) = CDate(Tarih)
        End If
    Next
  
    If Say > 0 Then
        S2.Cells(S2.Rows.Count, 1).End(3)(2, 1).Resize(UBound(Liste, 1), UBound(Liste, 2)) = Liste
        MsgBox "Veri aktarımı tamamlanmıştır." & vbCr & vbCr & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    Else
        MsgBox "Uygun kayıt bulunamadı!", vbExclamation
    End If

    Set S1 = Nothing
    Set S2 = Nothing
    Set Dizi = Nothing
End Sub

 

[reosman]

Çok teşekkür ederim ilginize hocam. Deneyip bilgi vereceğim.

 

[reosman]

Hocam şu şekilde bir hata alıyorum.

 

[reosman]

Hocam şu şekilde bir hata alıyorum.

 

[Korhan Ayhan]

Paylaştığınız dosyanızda ben hata almıyorum.

 

[reosman]

Hocam özür dilerim haklsınız lakin şunu unuttum bende 175 kayıt var birde iz sayfasında yüreğir ve sarıçam filtrelemesi var bundan olabilir. Mevcut deneme amaçlı 5 kayıt koymuştum bunları aktarıyor fakat esas dosyamda hata veriyor.Saygılarımla.

 

[reosman]

Hocam en fazla 6 kayıt aktarıyor.

 

[Korhan Ayhan]

Esas dosyanızda ki durumdan bahsetmezseniz elbette farklı durumlar oluşabilir. Her defasında "Örnek dosyanızın yapısal olarak asıl dosyanızla aynı olsun" şeklinde yazmaktan elimizde tüy bitti.

Asıl dosyanızda ki durumu içerecek şekilde 20-30 satır örnek veri içeren yeni örnek dosya paylaşırsanız ve aktarımın nasıl olması gerektiğini açıklarsanız sorunun neden kaynaklandığını anlayabiliriz.

 

[reosman]

Esas dosyanızda ki durumdan bahsetmezseniz elbette farklı durumlar oluşabilir. Her defasında "Örnek dosyanızın yapısal olarak asıl dosyanızla aynı olsun" şeklinde yazmaktan elimizde tüy bitti.

Asıl dosyanızda ki durumu içerecek şekilde 20-30 satır örnek veri içeren yeni örnek dosya paylaşırsanız ve aktarımın nasıl olması gerektiğini açıklarsanız sorunun neden kaynaklandığını anlayabiliriz.

Aktarım şekli doğru hocam, sadece 6 kayıttan fazla aktarılmıyor. Saygılarımla.

 

[Ziynettin]

@Korhan Ayhan yazdığı kod satırında ReDim Liste(1 To 6, 1 To Son) yerine ReDim Liste(1 To UBound(Veri), 1 To 6) olarak düzenleyiniz.

 

[reosman]

Ziynettin ve Korhan hocam, ayrı ayrı teşekkür ederim. Sagolun. Varolun. İyiki varsınız.

 

[Korhan Ayhan]

Evet dizinin satır ve sütun indisini ters tanımlamışım. 6 satırlık örnek olduğu ve sütun sayısı ile aynı sayıda satır olduğu için hata vermemişti. Çoklu satırda denediğinizde hata almanız kaçınılmaz olmuş. Bende #2 nolu mesajımda ilgili satırı revize ettim.

 

[reosman]

Evet dizinin satır ve sütun indisini ters tanımlamışım. 6 satırlık örnek olduğu ve sütun sayısı ile aynı sayıda satır olduğu için hata vermemişti. Çoklu satırda denediğinizde hata almanız kaçınılmaz olmuş. Bende #2 nolu mesajımda ilgili satırı revize ettim.

Hocam ilgi ve alakanıza çok teşekkür ederim. Saygılarımla.

 

[reosman]

Evet dizinin satır ve sütun indisini ters tanımlamışım. 6 satırlık örnek olduğu ve sütun sayısı ile aynı sayıda satır olduğu için hata vermemişti. Çoklu satırda denediğinizde hata almanız kaçınılmaz olmuş. Bende #2 nolu mesajımda ilgili satırı revize ettim.

Korhan hocam, bu kodlara mükerrer kayıt varsa, ..... sicil numarası ile mükerrer kayıt var yinede aktarılmasını istiyormusunuz şeklinde
bir uyarlama yapabilirmiyiz rica etsem.

 

[reosman]

Korhan hocam yardımınızı rica ediyorum.

 

[reosman]

Üstadlarım yardımlarınızı rica ediyorum

 

[Korhan Ayhan]

Diyelim ki 1000 satır veri aktardınız. Sonra butona tekrar tıkladınız. Talebinize göre size 1000 defa mesaj vererek aktarıma devam etmek istiyor musunuz diyecek. Bana pek mantıklı gelmedi. Zaten kodun içinde mükerrer aktarımı engelleyen bir yapı var.

 

[reosman]

Hocam pek nadir olacak fakat tek seferde tüm mükerrerleri msgbox da belirtebilşr

 

[reosman]

Hocam userform üzerinde seçim ekranıda olabilir. Mükerrerlerden aktarılacak veya aktarılmayacakları seçerek.