[Συναρτήσεις] Σύγκριση 2 στηλών με δεδομένα και μεταφορά σε άλλο φύλλο

[Spirosgr]

Καλημέρα.
Μια λύση, με κώδικα.
Ξεκαθάρισμα και μεταφορά 30.000 εγγραφών σε 3,58 sec
---------------------------------------------------------------------------------------
Σε μια module, αντιγράφουμε τον κώδικα:

Sub RelocateValues()
    Dim i As Long, Lr1 As Long, Nr2 As Long
    'Ορισμός τελευταίας γραμμής φύλλου εκκίνησης
    Lr1 = Sh1.Cells(Rows.Count, 1).End(xlUp).Row
    'Απενεργοποίηση οθόνης
    Application.ScreenUpdating = False
    'Καθαρισμός προορισμού
    Sh2.Range("a2:b" & Rows.Count).ClearContents
    'Μεταφορά (αν υπάρχει κεφαλίδα i = 2, άλλως i = 1)
    For i = 2 To Lr1
        'Ορισμός τελευταίας γραμμής φύλλου προορισμού
        Nr2 = Sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1
        'Συνθήκη μεταφοράς (όχι κενά - barcode με 8 χαρακτήρες)
        If Sh1.Cells(i, 1).Value <> vbNullString And _
           Len(Sh1.Cells(i, 1)) = 8 And _
           Sh1.Cells(i, 2).Value <> vbNullString Then
            'Μεταφορά τιμών - μορφοποίηση προορισμού
            Sh2.Cells(Nr2, 1).NumberFormat = "@"
            Sh2.Cells(Nr2, 1).Value = Sh1.Cells(i, 1).Value
            Sh2.Cells(Nr2, 2).NumberFormat = "###0"
            Sh2.Cells(Nr2, 2).Value = Sh1.Cells(i, 2).Value
        End If

    Next i
    'Επαναφορά οθόνης
    Application.ScreenUpdating = True
    Exit Sub
End Sub

Τι θα κάνει:
Θα μεταφερθούν, όλοι οι σωστοί κωδικοί (κελιά χωρίς κενά και μήκος 8 χαρακτήρες)
που έχουν στο δεξί κελί τιμή.
Ο barcode θα μεταφερθεί ως text.

Σημειώσεις:
1. Όπου sh1 το κωδικό όνομα του φύλλου εκκίνησης.
2. Όπου sh2 το κωδικό όνομα του φύλλου προορισμού.
3. Αν ο barcode έχει περισσότερους - λιγότερους από 8 χαρακτήρες,
αλλάξτε την γραμμή:
Len(Sh1.Cells(i, 1)) = 8
4. Αν χρειαστεί (ανάλογα με το περιεχόμενο της 2ης στήλης) αλλάξτε:
Μορφοποίηση Sh2.Cells(Nr2, 2).NumberFormat = "###0"
5. Αν η στήλη κωδικών, είναι <> από την 1η (Α) αλλάξτε το 1, όπου χρειαστεί πχ
Sh2.Cells(Nr2, 1).Value = Sh1.Cells(i, 1).Value
6. Αν η στήλη τιμών, είναι <> από την 2η (Β) αλλάξτε το 2, όπου χρειαστεί πχ
Sh2.Cells(Nr2, 2).Value = Sh1.Cells(i, 2).Value
*Όμοια τα a και b πχ
Sh2.Range("a2:b" & Rows.Count).ClearContents