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

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 με , )

Please sign in to comment

You will be able to leave a comment after signing in



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

Σημαντικό

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