veriyi bölme, ayırma

[sevensuleyman]

merhaba ;
-888 ile biten barkodları diğer sayfaya bir buton yardımı ile verileri ayırmnak istiyorum. ilk sayfa -888 ile başlamayan veriler 2. sayfa -888 ile başlayan veriler olarka ikiye ayrılacak. yaklaşık veri adedimiz 110.000 civarında dosya şişmesin die azaltarak yükledim. mümkünse çok uzun sürmeyecek şekilde kod yazarsanız yardımcı olursanız sevinirim.

 

[Korhan Ayhan]

Merhaba,

Öncelikle verilerinizi yedekleyiniz.

Dosyanıza Sayfa2 adında bir sayfa ekleyiniz.

İlk sayfadaki başlık satırını bu yeni sayfaya kopyalayın. Sonra aşağıdaki kodu deneyiniz.

Option Explicit

Sub Split_Data()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Veri As Variant, Son As Long, X As Long
    Dim Say_A As Long, Say_B As Long, Zaman As Double
    
    Zaman = Timer
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    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_A(1 To S1.Rows.Count, 1 To 6)
    ReDim Liste_B(1 To S1.Rows.Count, 1 To 6)
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 1) <> "" Then
            If Right(Veri(X, 2), 3) <> "888" Then
                Say_A = Say_A + 1
                Liste_A(Say_A, 1) = Veri(X, 1)
                Liste_A(Say_A, 2) = Veri(X, 2)
                Liste_A(Say_A, 3) = Veri(X, 3)
                Liste_A(Say_A, 4) = Veri(X, 4)
                Liste_A(Say_A, 5) = Veri(X, 5)
                Liste_A(Say_A, 6) = Veri(X, 6)
            Else
                Say_B = Say_B + 1
                Liste_B(Say_B, 1) = Veri(X, 1)
                Liste_B(Say_B, 2) = Veri(X, 2)
                Liste_B(Say_B, 3) = Veri(X, 3)
                Liste_B(Say_B, 4) = Veri(X, 4)
                Liste_B(Say_B, 5) = Veri(X, 5)
                Liste_B(Say_B, 6) = Veri(X, 6)
            End If
        End If
    Next
    
    If Say_A > 0 Then
        S1.Range("A2:F" & S1.Rows.Count).ClearContents
        S1.Range("A2").Resize(Say_A, 6) = Liste_A
    End If
    
    If Say_B > 0 Then
        S2.Range("A2:F" & S2.Rows.Count).ClearContents
        S2.Range("A2").Resize(Say_B, 6) = Liste_B
    End If
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "Veriler ayrıştırılmıştır." & vbCr & vbCr & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub