Μετάβαση στο περιεχόμενο

Recommended Posts

Δημοσιεύτηκε

 

 

 

Στο cell Α1 = "δοκιμή διαχωρισμού κειμένου με διαφορετικό διαχωριστικό π.χ. - ή / ή οτιδήποτε"

εντολή 

Separator(A1;1) = δοκιμή

Separator(A1;2) = διαχωρισμού

Separator(A1;2;"-") = - ή / ή οτιδήποτε

 

Σε ένα module γράφουμε τον παρακάτω κώδικα

 

Function Separator(strCell As String, NumWord As Long, Optional Sep As String = " ") As String
 Dim a As Integer, b As Integer, Kena As Long
 Dim Start(1 To 15) As Long, Leght(1 To 15) As Long
 
 For b = 1 To 15
    Start(b) = 1
    Leght(b) = 1
 Next b
 strCell = TrimAll(strCell)
 Kena = CountIn(strCell, Sep)
 
 For a = 1 To Kena + 1
    If a = 1 Then
        Start(1) = 0
        Leght(1) = InStr(1, strCell, Sep, vbBinaryCompare)
    Else
        Start(a) = InStr(Start(a - 1) + 1, strCell, Sep, vbBinaryCompare)
        If InStr(Start(a) + 1, strCell, Sep, vbBinaryCompare) = 0 Then
            Leght(a) = Len(strCell) - Start(a) + 1
        Else
            Leght(a) = InStr(Start(a) + 1, strCell, Sep, vbBinaryCompare) - Start(a)
        End If
    End If
 Next a
 
 If NumWord = 1 Then
 Separator = (Left$(strCell, Leght(1)))
 Else
 Separator = (Mid$(strCell, Start(NumWord), Leght(NumWord)))
 End If
 'Separator = Leght(NumWord)
 End Function
 
Function TrimAll(ByVal strInput As String, _
 Optional blnRemoveTabs As Boolean = True) As String
 Const conTowSpace = "  "
 Const conSpace = " "
 strInput = Trim$(strInput)
 If blnRemoveTabs Then
    strInput = Replace(strInput, vbTab, conSpace)
 End If
 Do Until InStr(strInput, conTowSpace) = 0
    strInput = Replace(strInput, conTowSpace, conSpace)
 Loop
 TrimAll = strInput
 End Function

 Function CountIn(strText As String, strFind As String, _
 Optional lngCompare As VbCompareMethod = vbBinaryCompare) As Long
 Dim lngCount As Long
 Dim lngPos As Long
 If Len(strFind) > 0 Then
    lngPos = 1
    Do
        lngPos = InStr(lngPos, strText, strFind, lngCompare)
        If lngPos > 0 Then
            lngCount = lngCount + 1
            lngPos = lngPos + Len(strFind)
        End If
    Loop While lngPos > 0
 Else
    lngCount = 0
 End If
 CountIn = lngCount
 End Function

split data from one cell to multiple cells.xlsm

Δημοσιεύτηκε

Μπορείς και έμμεσα μέσω μόνο excel να "τραβήξεις" τα νούμερα

πχ με τον τύπο

=MID(A1;SEARCH("=";A1);SEARCH(",";A1)-SEARCH("=";A1))

σε μία στήλη δίπλα, "τραβάς" το νούμερο ή το κείμενο που βρίσκεται μεταξύ του "=" και του "," δηλαδή το Χ

και με το

=RIGHT(A1;11)

μπορείς να πάρεις το Υ, αρκεί να είναι σταθερά 11 χαρακτήρες

(δεν κάθομαι τώρα να σκεφτώ κάτι περισσότερο αυτοματοποιημένο αλλά μπορείς αντί για 11 πχ να βάλεις κάτι καλύτερο χρησιμοποιώντας search για το 2ο "=" και το πλήθος ψηφίων του κελιού)

  • Like 2
Δημοσιεύτηκε

To open/libre office έχει την REGEX, αλλά αν δεν κατέ'εις από regular expressions πιο γρήγορα θα το κάνεις με το χέρι (εκτός κ αν έχει όρεξη για λίγο διάβασμα) (προφανώς ούτε εγώ κατέχω, αλλιώς θα στο έλεγα).

Άλλη λύση είναι να το κάνεις  .csv με το notepad και να το κάνεις import. (To = κάντο replace με , )

Δημιουργήστε ένα λογαριασμό ή συνδεθείτε προκειμένου να αφήσετε κάποιο σχόλιο

Πρέπει να είστε μέλος για να μπορέσετε να αφήσετε κάποιο σχόλιο

Δημιουργία λογαριασμού

Κάντε μια δωρεάν εγγραφή στην κοινότητά μας. Είναι εύκολο!

Εγγραφή νέου λογαριασμού

Σύνδεση

Εάν έχετε ήδη λογαριασμό; Συνδεθείτε εδώ.

Συνδεθείτε τώρα
×
×
  • Create New...

Σημαντικό

Χρησιμοποιούμε cookies για να βελτιώνουμε το περιεχόμενο του website μας. Μπορείτε να τροποποιήσετε τις ρυθμίσεις των cookie, ή να δώσετε τη συγκατάθεσή σας για την χρήση τους.