Veri Sıralama

[aksoy53]

Ekli excel dosyasında 3 sayfadan oluşmaktadır
1-mevcut kitaplar
2-listele
3-listelebecek barkod numaraları

listelenecek barkod numaraları sayfasında elle yazılan karışık barkodları verileri mevcut kitaplardan alarak listele sayfasına aktaracak kod istiyorum

elle yada okutarak barkod numaraları 50.000 yada fazla olabilir.

Bu konuda yardımlarınızı esirgemeyeceğınızı umuyorum.

 

[Ziynettin]

Merhaba,

Dosya ekte,

Option Explicit
Sub dusey_aktar()
On Error Resume Next
Dim s1 As Worksheet, s2 As Worksheet, s3 As Worksheet
Dim a(), b(), c(), e(), d As Object
Dim i As Long, y As Byte, say As Long, z As Date
z = TimeValue(Now)
Set d = CreateObject("scripting.dictionary")
Set s1 = Sheets("MEVCUT KİTAPLAR")
Set s2 = Sheets("LİSTELE")
Set s3 = Sheets("LİSTELENECEK BARKOD NUMARALARI")
a = s1.Range("A2:M" & s1.Cells(Rows.Count, 1).End(3).Row).Value
ReDim b(1 To UBound(a), 1 To UBound(a, 2))
For i = 1 To UBound(a)
    If Not d.exists(a(i, 1)) Then
        say = say + 1
        d.Add a(i, 1), say
        For y = 1 To UBound(a, 2)
            b(say, y) = a(i, y)
        Next y
    End If
Next i
c = s3.Range("A1:A" & s3.Cells(Rows.Count, 1).End(3).Row).Value
ReDim e(1 To UBound(c), 1 To UBound(a, 2))
For i = 1 To UBound(c)
    For y = 1 To UBound(a, 2)
        e(i, y) = a(d(c(i, 1)), y)
    Next y
Next i
s2.Range("A2:M" & Rows.Count).ClearContents
s2.[A2].Resize(UBound(c)).NumberFormat = "@"
s2.[A2].Resize(UBound(c), UBound(a, 2)) = e
s2.Select
MsgBox "İşlem tamam..." & vbLf & vbLf & _
"İşlem süreniz :  " & CDate(TimeValue(Now) - z), vbInformation
End Sub

 

[aksoy53]

Çok teşekkür ederim iyi ki varsınız çok makbule geçti