Çözüldü iki satır arası veri alma

[tukayf]

Değerli hocalarım işin içinden çıkamadım nette de örneğini bulamadığım bir sorum var. Ekteki dosyada açıklamaya çalıştım. Tek bir sütundan binlerce satır var ve bu satırdaki veriler open #1 ile başlayıp modify #1 ile bitiyor. Ben bunları ardışık olarak yan sütunlara almak istiyorum. Yani her open # ile başlayan ve modify # ile biten değerleri farklı bir sütuna almak istiyorum ama aklıma bir çözüm gelmedi. Çözüm önerisi ya da direk çözümü verebilirseniz çok memnun olurum şimdiden yardımlar için çok teşekkürler.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Yan_Yana_Aktar()
    Dim Veri As Variant, Son As Long, X As Long, Say As Long, Y As Integer, Sutun As Integer, Zaman As Double
    
    Zaman = Timer
    
    Range("C1").Resize(50, Columns.Count - 2).ClearContents
    
    Son = Cells(Rows.Count, 1).End(3).Row
    If Son = 2 Then Son = 3
    
    Veri = Range("A2:A" & Son).Value
    
    ReDim Liste(1 To 50, 1 To Columns.Count - 2)
    
    Sutun = 1
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Left(Veri(X, 1), 5) = " open" Then
            Say = Say + 1
            Liste(Say, Sutun) = Veri(X, 1)
            For Y = X + 1 To X + 50
                If Left(Veri(Y, 1), 7) <> " modify" Then
                    Say = Say + 1
                    Liste(Say, Sutun) = Veri(Y, 1)
                Else
                    Say = Say + 1
                    Liste(Say, Sutun) = Veri(Y, 1)
                    Say = 0
                    Sutun = Sutun + 1
                    X = Y
                    Exit For
                End If
            Next
        End If
    Next
    
    Range("C2").Resize(50, Sutun) = Liste
    Columns.AutoFit
    
    MsgBox "İşleminiz tamamlanmıştır." & vbLf & vbLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub

 

[tukayf]

Sn. Hocam çok teşekkürler. Çözümünüz gerçekten müthiş. Ama veriyi çoğaltınca bir kaç farklı hata verdi.

 

[Korhan Ayhan]

Her blok için 50 satır olabilir gibi koşul eklemiştim. Sizin örnek dosyadaki gruplar 10 satırlık gruplardı.

Hata veren örnek paylaşırsanız neden kaynaklandığına bakabiliriz.

 

[tukayf]

böyle bir hata geldi hocam.

 

[tukayf]

İşin ilginç yanı bir blokta maksimum 51 satır var. birde bu şekilde hata aldım. Ama doğru sonuç aldığım zamanlarda oluyor anlayamadım. orijinal dosya boyutu büyük olduğu için yükleyemedim. yine küçük bir örnek yükledim hocam.

 

[Korhan Ayhan]

Hata şundan kaynaklanıyor.

En son 155. satırdaki "open" bloğunun "modify" olarak kapanış satırı yok. Bu sebeple hata oluşmaktadır.

Böyle durumlar varsa kodu revize etmek gerekir.

Ayrıca veri sayınız çoksa sonuç verileri yan yana yazıldığı için excelin sütunları yetmeyebilir.

Deneyiniz.

Option Explicit

Sub Yan_Yana_Aktar()
    Dim Veri As Variant, Son As Long, X As Long, Say As Long, Y As Long, Sutun As Integer, Zaman As Double
   
    Zaman = Timer
   
    Range("C1").Resize(55, Columns.Count - 2).ClearContents
   
    Son = Cells(Rows.Count, 1).End(3).Row
    If Son = 1 Then Son = 2
   
    Veri = Range("A1:A" & Son).Value
   
    ReDim Liste(1 To 1000, 1 To Columns.Count - 2)
   
    Sutun = 1
   
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Left(Veri(X, 1), 5) = " open" Then
            Say = Say + 1
            Liste(Say, Sutun) = Veri(X, 1)
            For Y = X + 1 To UBound(Veri, 1)
                If Left(Veri(Y, 1), 7) <> " modify" Then
                    Say = Say + 1
                    Liste(Say, Sutun) = Veri(Y, 1)
                Else
                    Say = Say + 1
                    Liste(Say, Sutun) = Veri(Y, 1)
                    Say = 0
                    Sutun = Sutun + 1
                    X = Y
                    Exit For
                End If
            Next
        End If
    Next
   
    Range("C2").Resize(1000, Sutun) = Liste
    Columns.AutoFit
   
    MsgBox "İşleminiz tamamlanmıştır." & vbLf & vbLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub

 

[tukayf]

Budur hocam çok teşekkürler.

 

[Korhan Ayhan]

Asıl dosyanızda işlem ne kadar sürüyor?

 

[tukayf]

400 bin satırlık veride pentium işlemcide 6.20 saniye, i3 8 nesilde 4,59 saniye i5 7 nesilde 4,53 saniye, i7 8 nesilde 3,96 saniye hocam.