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

Καλημέρα.
Μια λύση, με κώδικα.
Ξεκαθάρισμα και μεταφορά 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