Come eliminare parte di una frase

[raimea]

ciao
con una macro vorrei eliminare alcune parole SPECIFICHE in determinate celle
partendo dalla riga 8, e lasciando il resto della frase
in col D
togliere DATA:
col E
Camp.:
col F
Ris.:
col G
Evento:
col i
Bet Live:

allego il file

grazie

ciao




https://www.dropbox.com/s/kzhd5upvlwjb88e/bot_radar_20.rar?dl=0

[Anthony47]

Si puo' facilmente fare con 1 formula che usi la funzione Sostituisci, ma immagino che la cosa sia da fare spesso, per cui ti propino questa macro:

Codice: Seleziona tutto

Sub Normal()
Dim MArr, I As Long, J As Long, reTxt As String
'
'0=Text; 1=Data; 2=Numero
MArr = Array(4, "DATA:", 1, "/", 5, "Camp.:", 0, "/", 8, "Min:", 2, "/")         '<<< vedi testo
For J = 8 To Cells(Rows.Count, "D").End(xlUp).Row
    For I = 0 To UBound(MArr) Step 4
        reTxt = Trim(Replace(Cells(J, MArr(I)).Value, MArr(I + 1), "", , , vbTextCompare))
            If MArr(I + 2) = 0 Then
                Cells(J, MArr(I)).Value = CStr(reTxt)   'Stringa
            ElseIf MArr(I + 2) = 1 Then
                Cells(J, MArr(I)).Value = CDate(reTxt)  'Data
            ElseIf MArr(I + 2) = 2 Then
                Cells(J, MArr(I)).Value = CSng(reTxt)   'Numero
            End If
        End If
    Next I
Next J
End Sub


Va messa in un Modulo Standard del vba

La chiave della macro e' il contenuto di MArr, che devi compilare seguendo questo schema:
-primo termine, il numero della Colonna
-secondo termine, la stringa da eliminare
-terzo termine, il "tipo" di dati da produrre: '0=Text; 1=Data; 2=Numero
-quarto termine, usato solo come separatore visibile dei blocchi quindi gli inserirai "/"
-ripeti per ogni colonna della riga da modificare il blocco di 4 informazioni

In modo dimostrativo io ho compilato quanto serve per le colonne D, E e H

Prova e fai sapere...

[raimea]

ciao

si blocca subito dando questo errore:

[raimea]

risolto
tolto end if di troppo

[raimea]

ciao
ho provato ad ampliarla
ad ES sistemando la col F (6)

ma mi da errore
io ho ampliata cosi :

Codice: Seleziona tutto

Sub Normal()
Dim MArr, I As Long, J As Long, reTxt As String
'
'0=Text; 1=Data; 2=Numero
MArr = Array(4, "DATA:", 1, "/", 5, "Camp.:", 0, "/", 8, "Min:", 2, "/" 6, "Ris.:", 2, "/")         '<<< vedi testo
For J = 8 To Cells(Rows.Count, "D").End(xlUp).Row

    For I = 0 To UBound(MArr) Step 4
        reTxt = Trim(Replace(Cells(J, MArr(I)).Value, MArr(I + 1), "", , , vbTextCompare))
            If MArr(I + 2) = 0 Then
                Cells(J, MArr(I)).Value = CStr(reTxt)   'Stringa
            ElseIf MArr(I + 2) = 1 Then
                Cells(J, MArr(I)).Value = CDate(reTxt)  'Data
            ElseIf MArr(I + 2) = 2 Then
                Cells(J, MArr(I)).Value = CSng(reTxt)   'Numero
            End If
       
    Next I
Next J
End Sub


[raimea]

ciao

ho aggiunto altre 2 colonne ed e' ok
ho problemi a far sistemare la col (6) F

questo il cod modificato.

Codice: Seleziona tutto

Sub Normal()
Dim MArr, I As Long, J As Long, reTxt As String
'
'0=Text; 1=Data; 2=Numero
MArr = Array(4, "DATA:", 1, "/", 5, "Camp.:", 0, "/", 8, "Min:", 2, "/", 9, "Bet live:", 0, "/", 7, "Evento:", 0, "/")         '<<< vedi testo
For J = 8 To Cells(Rows.Count, "D").End(xlUp).Row

    For I = 0 To UBound(MArr) Step 4
        reTxt = Trim(Replace(Cells(J, MArr(I)).Value, MArr(I + 1), "", , , vbTextCompare))
            If MArr(I + 2) = 0 Then
                Cells(J, MArr(I)).Value = CStr(reTxt)   'Stringa
            ElseIf MArr(I + 2) = 1 Then
                Cells(J, MArr(I)).Value = CDate(reTxt)  'Data
            ElseIf MArr(I + 2) = 2 Then
                Cells(J, MArr(I)).Value = CSng(reTxt)   'Numero
            End If
       
    Next I
Next J
End Sub

la col F togliendo " Ris.:"
mi confonde i risultati come date

ciao

[Anthony47]

Allora modifica la riga Cells(J, MArr(I)).Value = CStr(reTxt) 'Stringa in

Codice: Seleziona tutto

                Cells(J, MArr(I)).Value = "'" & reTxt   'Stringa


Ciao

[raimea]

ciao
sistemato
tutto ok

grazie

[raimea]

ciao
la macro -normal - (Puls. Sistema le Colonne)

sopra riportata funziona correttamente
ho aggiunto io alcuni "fronzoli" ma e' tutto ok

solo che ora le righe da sistemare sono diventate molte

sono a chiedere :
sarebbe possibile renderla un po piu veloce ?

vi allego il file con le ultime 3 righe da sistemare

ciao

https://www.dropbox.com/s/p3giqpjuh9agal6/bot_radar_20%20-%20Copia.rar?dl=0

[Anthony47]

Senza stravolgere la macro, un certo miglioramento si ha modificando il ciclo principale in questo modo:

Codice: Seleziona tutto

MArr = Array(4, "DATA:", 1, "/", 5, "Camp.:", 0, "/", 8, "Min:", 2, "/", 9, "Bet live:", 0, "/", 7, "Evento:", 0, "/", 6, "Ris.:", 0, "/")         '<<< vedi testo
Dim myTim As Single, iVal As String, myTim0 As Single      'Nuove
myTim0 = Timer
For J = 8 To Cells(Rows.Count, "D").End(xlUp).Row
myTim = Timer
    For i = 0 To UBound(MArr) Step 4
        iVal = Cells(J, MArr(i)).Value
        reTxt = Trim(Replace(iVal, MArr(i + 1), "", , , vbTextCompare))
            If Len(iVal) > Len(reTxt) Then                  'If aggiunto
                If MArr(i + 2) = 0 Then
                    Cells(J, MArr(i)).Value = "'" & reTxt   'Stringa
                ElseIf MArr(i + 2) = 1 Then
                    Cells(J, MArr(i)).Value = CDate(reTxt)  'Data
                ElseIf MArr(i + 2) = 2 Then
                    Cells(J, MArr(i)).Value = CSng(reTxt)   'Numero
                End If
            End If
    Next i
''Debug.Print Timer - myTim
Next J
''Debug.Print Timer - myTim0

La modifica consiste nell'aggiungere un ulteriore If, come evidenziato nel codice.

Fai sapere se e' sufficiente

Ciao

[raimea]

ciao
SI
ora e molto piu veloce

ringrazio

ciao