Forum - VBA Διαχωρισμός σε άλλες στήλες

Καλημέρα
Ο κώδικας είναι γραμμένος για να δουλεύει πάντα στις γραμμές 2 έως 7.
Επειδή έχεις δύο ονόματα στο παράδειγμα,
όταν τελειώσει με αυτά και δεν βρεί άλλα, φυσικό είναι να χτυπάει.

Αυτό διορθώνεται αν βάλουμε:

Κώδικας:

On Error Resume Next

Πριν από το For i....

Έχει όμως ένα μεγάλο σφάλμα στην διαχείριση των ονομάτων,
αν έχει πληκτρολογήσει ο χρήστης κενά (Space) εκ παραδρομής,
είτε στην αρχή είτε στο τέλος (πράγμα που διαπίστωσα ότι ισχύει)
Το ΔΗΜΗΤΡΗΣ, ΚΟΝΤΟΣ, ακολουθείται από κενό...

Θα πρότεινα να χρησιμοποιήσεις τον πιο κάτω κώδικα:

Κώδικας:

Sub SplitNames_Delimeter()

    Dim fName As String, iPos As Integer

    Dim Lrow As Long, i As Long

    Lrow = Sh1.Cells(Rows.Count, 1).End(xlUp).Row
 

    For i = 2 To Lrow

        fName = Trim(Cells(i, 1).Value)

        iPos = InStr(fName, ",")

        Cells(i, 2).Value = Left(fName, iPos - 1)

        Cells(i, 3).Value = Mid(fName, iPos + 2)

    Next i

End Sub

Παρατηρήσεις:
Όπου Sh1 το κωδικό όνομα φύλλου.

Ο κώδικας αυτός λειτουργεί σωστά αν:
1
Τα ονόματα είναι στην Α στήλη.
Αν αλλάξει αυτό, αλλάζουμε τον κόκκινο αριθμό, με τον αριθμό στήλης.
2
Η μεταφορά γίνεται στις B - C
Αν αλλάξει κάτι από αυτά, αλλάζουμε τους μπλε αριθμούς, με τους αριθμούς στηλών.
3
Διαχωριστικό είναι το ,
Αν αλλάξει, αλλάζουμε στην γραμμή

Κώδικας:

iPos = InStr(fName, ",")

με ότι θέλουμε.
Παράδειγμα για διαχωριστικό -

Κώδικας:

iPos = InStr(fName, "-")

4
Το διαχωριστικό ακολουθείται από ένα κενό (Space)
Αν αλλάξει αυτό, θα πρέπει να προσαρμοστούν τόσο το

Κώδικας:

iPos = InStr(fName, ",")

όσο και οι αριθμοί στο τέλος των φράσεων

Κώδικας:

        Cells(i, 2).Value = Left(fName, iPos - 1)

        Cells(i, 3).Value = Mid(fName, iPos + 2)

Παράδειγμα για κενό ανάμεσα σε όνομα επώνυμο, χωρίς διαχωριστικό.

Κώδικας:

        iPos = InStr(fName, " ")

        Cells(i, 2).Value = Left(fName, iPos - 1)

        Cells(i, 3).Value = Right(fName, iPos + 1)

5
Δεν υπάρχουν κενά ονόματα (γραμμές χωρίς δεδομένα)
Αν πρέπει να υπάρχουν (;;;) τότε να γίνει και πάλι η χρήση του On Error Resume Next
Τέλος...
Εφ' όσον έχουμε μόνο επώνυμο και όνομα (χωρίς πατρώνυμο)
η χρήση της Mid, μπορεί να αντικατασταθεί από την Right