preleva ultime lettere dopo una parentesi quadra

[raimea]

ciao

tramite macro vorrei compilare
la col H del fgl generale

nella col H da riga 8
vorrei inserire la parte terminale del contenuto
nella cella di col G

vorrei scrivere in H quello che c'e dopo
la parentesi quadra,
riportanto anche il segno + e -
( in tot saranno max 4 caratteri)



PS
so che e' una richiesta simile a quella che
ho fatto in questa discussine

viewtopic.php?f=26&t=113789

ma non sono riuscito ad adattare la macro di Raffaele53


vi allego il file

https://www.dropbox.com/scl/fi/xonfg9oa ... 7n1er&dl=0

ciao

[raimea]

forse ci sono riuscito in autonomia
posto il codice

Codice: Seleziona tutto

Sub EstraiUltimeQuattroCifre()
    Dim ws As Worksheet
    Dim ultimaRiga As Long
    Dim i As Long
    Dim valoreG As String
   
    Set ws = ActiveSheet
   
    ' Trova l'ultima riga con dati nella colonna G
    ultimaRiga = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
   
    Application.ScreenUpdating = False
   
    ' Scorre ogni riga e inserisce la formula/valore
    For i = 8 To ultimaRiga ' Parte dalla riga 8 (assumendo che la riga 1 sia l'intestazione)
        valoreG = Trim(CStr(ws.Cells(i, "G").Value))
       
        If Len(valoreG) >= 4 Then
            ws.Cells(i, "H").Value = "'" & Right(valoreG, 4)
        ElseIf Len(valoreG) > 0 Then
            ws.Cells(i, "H").Value = "'" & valoreG
        Else
            ws.Cells(i, "H").Value = ""
        End If
    Next i
   
    Application.ScreenUpdating = True
End Sub

unica cosa non riesco gestire il caso in cui dopo parentesi quadra non ci sia nulla !!
vorrei mettesse una X

ciao

[raimea]

versione 2
con questa riesco gestire il caso manchi la parentesi quadra
o il simbolo K

Codice: Seleziona tutto

Sub prelevadopoquadra()
    Dim ws As Worksheet
    Dim ultimaRiga As Long
    Dim i As Long
    Dim testo As String
    Dim pos As Long
   
    Set ws = ActiveSheet
   
    ' Trova l'ultima riga con dati nella colonna G
    ultimaRiga = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
   
    Application.ScreenUpdating = False
   
    For i = 8 To ultimaRiga ' Parte dalla riga 8
        testo = CStr(ws.Cells(i, "G").Value)
       
        ' Trova la posizione della parentesi quadra ']'
        pos = InStr(testo, "]")
       
        If pos > 0 Then
            '  colonna G con i 5 caratteri dopo ']'
            ws.Cells(i, "H").Value = "'" & Mid(testo, pos + 1, 5) ' 5 quanti caratteri dopo la parentesi quadra
        Else
            ' Se non viene trovata la parentesi ']', pulisce la cella (o rimuovi questa riga per lasciarla invariata)
            ws.Cells(i, "H").Value = "X"
        End If
   
    '----gestisco se manca K ---------
   
             
        '  controllo NON sensibile alle maiuscole/minuscole ("k" o "K")
        If InStr(1, testo, "k", vbTextCompare) = 0 Then
            ws.Cells(i, "H").Value = "X"
        Else
           
        End If
    Next i
       
   
    Application.ScreenUpdating = True
End Sub

non sara il cod piu snello ...
ma funziona

[raimea]

versione 3 !!!

con questa riesco gestire i casi in cui:

manca la parentesi quadra chiusa
manca una K dopo la parent quad. chiusa
manca la scritta dopo la parent. quadr. chiusa

Codice: Seleziona tutto

Sub prelevadopoquadra()
    Dim ws As Worksheet
    Dim ultimaRiga As Long
    Dim i As Long
    Dim testo As String
    Dim pos As Long
   
    Set ws = ActiveSheet
   
    ' Trova l'ultima riga con dati nella colonna G
    ultimaRiga = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
   
    Application.ScreenUpdating = False
   
    For i = 8 To ultimaRiga ' Parte dalla riga 8 (modifica a 1 se non hai intestazioni)
        testo = CStr(ws.Cells(i, "G").Value)
       
        ' Trova la posizione della parentesi quadra ']'
        pos = InStr(testo, "]")
       
        If pos > 0 Then
            ' riporta dati di  colonna G con i 5 caratteri dopo ']'
            ws.Cells(i, "H").Value = "'" & Mid(testo, pos + 1, 5) ' 5 quanti caratteri dopo la parentesi quadra
        Else
            ' Se non viene trovata la parentesi ']', pulisce la cella (o rimuovi questa riga per lasciarla invariata)
            ws.Cells(i, "H").Value = "X"
        End If
   
    '----gestisco gli errori---------

       
        ' Trova la posizione della parentesi quadra chiusa ']'
        posChiusa = InStr(testo, "]")
       
        If posChiusa > 0 Then
            ' Prende solo la porzione di testo che si trova DOPO la parentesi ']'
            testoDopo = Mid(testo, posChiusa + 1)
           
            ' Verifica se la 'k' NON è presente nella parte successiva alla parentesi
            If InStr(1, testoDopo, "k", vbTextCompare) = 0 Then
                ws.Cells(i, "H").Value = "X"
            Else
             
            End If
        Else

        End If
    Next i
End Sub


[Anthony47]

Sei l'unico che ha lavorato in questi giorni di festa

Non vorrei aver semplificato eccessivamente, ma (se hai voglia e tempo) prova anche questa:

Codice: Seleziona tutto

Sub Ago17()
Dim I As Long, mySplit
'
For I = 8 To Cells(Rows.Count, "G").End(xlUp).Row
    mySplit = Split(Cells(I, "G") & " ]X", "]", , vbTextCompare)
    Cells(I, "H").Value = mySplit(1)
Next I

End Sub


[raimea]

Sei l'unico che ha lavorato in questi giorni di festa

confermo...
con queste temperature mi son chiuso in casa con il climatiz...
inoltre mi son gia giocato il jolly vacanze a giugno


tutto ok
e' una super macro

grazie