Εμφάνιση ενός μόνο μηνύματος
  #2  
Παλιά 15-05-18, 08:21
Το avatar του χρήστη Spirosgr
Spirosgr Ο χρήστης Spirosgr δεν είναι συνδεδεμένος
Συντονιστής
Όνομα: Σπύρος Τσιλιγιάννης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2010, Ms-Office 2013, Ms-Office 2016, Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 22-11-2011
Περιοχή: Αθήνα
Μηνύματα: 2.321
Προεπιλογή

Καλημέρα
Ο κώδικας είναι γραμμένος για να δουλεύει πάντα στις γραμμές 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
Απάντηση με παράθεση