[excel] giustificare testo all'interno della cella

[LoryOne]

Inviato da borgata

Anche io all'inizio avevo valutato che fosse meglio agire programmaticamente per trovare le parole duplicate, poi ho visto che poteva essere fatto facilmente con le RE e quindi ho suggerito una RE apposita per farlo (vedi qualche post sopra).

Si, meglio sotto questo aspetto: L'espressione regolare verifica da sola quale sia la sequenza di caratteri ripetuti, ossia la stringa in oggetto, senza doverla necessariamente specificare

[Alexsandra]

Lo hai provato?

[LoryOne]

Se ti riferisci alle Regular Expression, non le ho provate nelle macro, ma qui dicono funzionino alla grande.
https://stackoverflow.com/questions/...cell-and-loops
Se ti riferisci al mio script, funziona con riserva, nel senso che da una stringa " China China China" potrebbe ricavare una stringa "China ", dove quegli spazi non sono spazi, bensì caratteri nulli non presi in considerazione da un'eventuale RTrim$
Se invece lo script fosse questo:

Function Rimpiazzamelo(ByVal S As String) As String
Dim Ss As String: Dim Pos As Long

Ss = LTrim$(S): Pos = InStr(Ss, ChrW(32))
If Pos Then 
         Rimpiazzamelo = RTrim$(Replace$(Ss, ChrW(32) & Left$(Ss, Pos - 1), vbNullString))
Else
         Rimpiazzamelo = Ss
End If         
End Function

La stringa " China China China" restituirebbe "China"

[gutguy]

intanto ringrazio tutti per le risposte, e mi scuso per il ritardo ma prob di lavoro e connessione ballerina mi hanno impedito
di rispondere prima...
ero rimasto al seguente codice del post #36

Sub prova1()
Sheets("Foglio1").Activate
'togliere Hyperlinks
Cells.Hyperlinks.Delete
'togliere il carattere [4]
Columns(2).Replace What:="[*]", Replacement:=""
'allineare a Dx
Columns("B:E").HorizontalAlignment = xlRight
' formattazione generale
Columns("B:C").NumberFormat = "General"
' 2 decimali finali
Columns("E").NumberFormat = "0.00"
'cambiare il punto con le virgole
For Each cell In ActiveSheet.UsedRange
If InStr(1, cell.Text, ".") > 0 Then
cell.Value = CDbl(Val(cell.Text))
'togliere gli spazi
Trim (cell.Text)
End If
Next
End Sub

non ho capito ora se la macro per togliere i doppioni del post #41
va lanciata a parte o se eventualmente è possibile integrarla

Sub pippo()

Dim ultimaC, Mstringa As String
Dim Ccol As Range
Dim Pspazio As Integer

ultimaC = Range("A1").End(xlDown).Address
For Each Ccol In Range("A2:" & ultimaC)
Mstringa = Ccol
Pspazio = InStrRev(Mstringa, " ", -1)
If Pspazio <> 0 Then
k = Left(Mstringa, Pspazio - 1)
k1 = Mid(Mstringa, Pspazio + 1)
If k = k1 Then
Ccol = k
End If
Else
End If
Next
End Sub

per qnt riguarda il post #40
vorrei applicarla

Inviato da borgata

ogni volta che si presenta una data situazione. cioè ogni volta che aggiorno i dati

ultima cosa, stavolta in word, come faccio ad appendere testo ad ogni riga?
ho provato una RE da qst sito facendo trova "^p" (senza apici) e sostituisci con "^p testo" (senza apici)
ma mi sbaglia la prima e ultima riga...
esiste una macro eventualmente?

[Alexsandra]

La puoi integrare così

Sub prova1()
Dim ultimaC, Mstringa As String
Dim Ccol As Range
Dim Pspazio As Integer

Sheets("Foglio1").Activate
'togliere Hyperlinks
Cells.Hyperlinks.Delete
'togliere il carattere [4]
Columns(2).Replace What:="[*]", Replacement:=""
'allineare a Dx
Columns("B:E").HorizontalAlignment = xlRight
' formattazione generale
Columns("B:C").NumberFormat = "General"
' 2 decimali finali
Columns("E").NumberFormat = "0.00"
'cambiare il punto con le virgole
For Each cell In ActiveSheet.UsedRange
If InStr(1, cell.Text, ".") > 0 Then
cell.Value = CDbl(Val(cell.Text))
'togliere gli spazi
Trim (cell.Text)
End If
Next

ultimaC = Range("A1").End(xlDown).Address
For Each Ccol In Range("A2:" & ultimaC)
Mstringa = Ccol
Pspazio = InStrRev(Mstringa, " ", -1)
If Pspazio <> 0 Then
k = Left(Mstringa, Pspazio - 1)
k1 = Mid(Mstringa, Pspazio + 1)
If k = k1 Then
Ccol = k
End If
Else
End If
Next
End Sub

[gutguy]

Inviato da Alexsandra

La puoi integrare così

Sub prova1()
Dim ultimaC, Mstringa As String
Dim Ccol As Range
Dim Pspazio As Integer

Sheets("Foglio1").Activate
'togliere Hyperlinks
Cells.Hyperlinks.Delete
'togliere il carattere [4]
Columns(2).Replace What:="[*]", Replacement:=""
'allineare a Dx
Columns("B:E").HorizontalAlignment = xlRight
' formattazione generale
Columns("B:C").NumberFormat = "General"
' 2 decimali finali
Columns("E").NumberFormat = "0.00"
'cambiare il punto con le virgole
For Each cell In ActiveSheet.UsedRange
If InStr(1, cell.Text, ".") > 0 Then
cell.Value = CDbl(Val(cell.Text))
'togliere gli spazi
Trim (cell.Text)
End If
Next

ultimaC = Range("A1").End(xlDown).Address
For Each Ccol In Range("A2:" & ultimaC)
Mstringa = Ccol
Pspazio = InStrRev(Mstringa, " ", -1)
If Pspazio <> 0 Then
k = Left(Mstringa, Pspazio - 1)
k1 = Mid(Mstringa, Pspazio + 1)
If k = k1 Then
Ccol = k
End If
Else
End If
Next
End Sub

mi da

[LoryOne]

...e cliccando su Debug, a quale riga si ferma l'esecuzione ?

[Alexsandra]

la macro gira, è probabile che tu non abbia "Foglio 1" oppure hai un altro nome

[gutguy]

Inviato da LoryOne

...e cliccando su Debug, a quale riga si ferma l'esecuzione ?

c'hai ragione...mi scuso anche con alexandra, mi sono sbagliato io, avevo lanciato la macro per errore in un altro foglio
ecco come appare il foglio dopo aver eseguito la macro:

http://tinyurl.com/glr5ofy

detto ciò non mi da nessun errore, solo non toglie gli spazi iniziali...
e finland dovrebbe essere 454000 e non 454...
altra cosa, se lo lancio su un altro foglio (potrei averne bisogno in futuro), cosa devo fare? C'è modo di abilitare una selezione dell'area in cui deve operare quando si lancia la macro?
un po' come il seguente:


ancora grz per la pazienza

[Alexsandra]

Inviato da gutguy

C'è modo di abilitare una selezione dell'area in cui deve operare quando si lancia la macro?

al momento no, l'area se la cerca il codice (inizio e fine righe) partendo dalla prima riga e fino alla riga che trova scritta.

per finland è un del pasticcio, nel senso che non sò come dire al codice cosa debba fare in quella cella specifica ??? ci penso

per il resto il codice diventa questo

Sub prova1()
Dim ultimaC, Mstringa As String
Dim Ccol As Range
Dim Pspazio As Integer

'togliere Hyperlinks
Cells.Hyperlinks.Delete
'togliere il carattere [4]
Columns(2).Replace What:="[*]", Replacement:=""
'allineare a Dx
Columns("B:E").HorizontalAlignment = xlRight
' formattazione generale
Columns("B:C").NumberFormat = "General"
' 2 decimali finali
Columns("E").NumberFormat = "0.00"
'cambiare il punto con le virgole
For Each cell In ActiveSheet.UsedRange
If InStr(1, cell.Text, ".") > 0 Then
cell.Value = CDbl(Val(cell.Text))
End If
Next

'togliere gli spazi
Columns(1).Replace What:=" ", Replacement:=""
'togliere doppioni nella cella
ultimaC = Range("A1").End(xlDown).Address
For Each Ccol In Range("A2:" & ultimaC)
Mstringa = Ccol
Pspazio = InStrRev(Mstringa, " ", -1)
If Pspazio <> 0 Then
k = Left(Mstringa, Pspazio - 1)
k1 = Mid(Mstringa, Pspazio + 1)
If k = k1 Then
Ccol = k
End If
Else
End If
Next
End Sub

così puoi lanciare la macro in qualsiasi foglio

[Alexsandra]

ho sbagliato
col codice che ti ho messo sopra togli tutti gli spazi, anche quelli tra 2 stringhe.

questo è quello giusto

Sub prova1()
Dim ultimaC, Mstringa As String
Dim Ccol As Range
Dim Pspazio As Integer

'togliere Hyperlinks
Cells.Hyperlinks.Delete
'togliere il carattere [4]
Columns(2).Replace What:="[*]", Replacement:=""
'allineare a Dx
Columns("B:E").HorizontalAlignment = xlRight
' formattazione generale
Columns("B:C").NumberFormat = "General"
' 2 decimali finali
Columns("E").NumberFormat = "0.00"
'cambiare il punto con le virgole
For Each cell In ActiveSheet.UsedRange
If InStr(1, cell.Text, ".") > 0 Then
cell.Value = CDbl(Val(cell.Text))
End If
Next

'togliere gli spazi
For Each oCell In Range(Cells(1, "A"), Cells(Rows.Count, 1).End(xlUp))
    With oCell
        .Value = Trim(.Value)
    End With
Next oCell

'togliere doppioni nella cella
ultimaC = Range("A1").End(xlDown).Address
For Each Ccol In Range("A2:" & ultimaC)
Mstringa = Ccol
Pspazio = InStrRev(Mstringa, " ", -1)
If Pspazio <> 0 Then
k = Left(Mstringa, Pspazio - 1)
k1 = Mid(Mstringa, Pspazio + 1)
If k = k1 Then
Ccol = k
End If
Else
End If
Next
End Sub

[gutguy]

ti ringrazio tanto...
ecco il risultato della macro

http://tinyurl.com/zq5yqdk

penso non si possa far nulla per finland

una cosa, se volessi lanciare la tua macro sulla scheda 2 di qst foglio cosa dovrei fare?
perché se lo lancio così non va...

[Alexsandra]

Inviato da gutguy

penso non si possa far nulla per finland

un sistema ci sarebbe, lasciami fare delle prove.
In sostanza si dovrebbe trasformarlo in migliaia, cioè aggiungere 3 zeri ???

una cosa, se volessi lanciare la tua macro sulla scheda 2 di qst foglio cosa dovrei fare?
perché se lo lancio così non va...

non va perchè le colonne non sono uguali, cancella la colonna 1 e lancia la macro, vedrai che funziona

[gutguy]

non ti preoccupare, anzi scusami piuttosto se ti metto fretta, non è mia intenzione...

Inviato da Alexsandra

In sostanza si dovrebbe trasformarlo in migliaia, cioè aggiungere 3 zeri ???

si aggiungere 3 zeri, quando l'ho copiato da un'origine americana era in migliaia evidentemente formattato alla loro maniera, quando l'ho incollato i tre zeri per un motivo che non conosco sono spariti.
dovrebbe diventare così:

[Alexsandra]

per finland si potrebbe fare una cosa del genere:
fatta la conversione della colonna possiamo leggere da quante cifre è composta.
se il n° di cifre è inferiore a 4 aggiungiamo 3 zeri

non è un procedimento tanto affidabile, ma è l'unico che mi è venuto in mente.