FIle complesso da cui estrapolare solo alcuni dati o dividere in colonne

Question

Buongiorno a tutti. Ho provato a cercare nel Forum ma non trovo nulla di analogo.

In pratica io ho un file strutturato in una maniera simile a quella seguente

1 Nome             |          

2 Via                 |

3 Citta               |

4 Tel:                 | 0123456789

5 Fax:                 | 7894561230

6 Email               | ******@email.it

7 Sito                 | www.sito.it

8 dato                | dato importante

9 dato2              | dato importante 2

10 dato3             | dato importante 3

11 dato4             | dato importante 4

12 Nome             |          

13 Via                 |

14 Citta               |

15 Tel:                 | 0123456789

16 Fax:                 | 7894561230

17 Email               | ******@email.it

18 Sito                 | www.sito.it

19 dato                | dato importante

20 dato2              | dato importante 2

21 dato3             | dato importante 3

22 dato4             | dato importante 4

ecc

Dove,"dato4" è sempre presente e segue sempre con "Nome", mentre le altre righe non ci sono sempre (cioè non posso contare 11 righe dall'inizio alla fine di ogni azienda.

il simbolo | significa "nuova colonna"

Allora quello che io sto cercando di fare è riuscire ad estrapolare i dati in maniera da avere un file dove ad ogni colonna nominata io avrei il valore di riferimento. cioè:

      NOME     |     VIA     |        CITTA             |     TEL     |        FAX             |     EMAIL     |        DATO     

1   azienda1    |     via1    |      citta1          |     tel1     |        fax         |     email1     |        dato1     

2   azienda2      |     via2    |        citta2             |     tel2     |        fax2          |     email2     |      dato2

3   azienda3      |     via3    |        citta3             |     tel3     |        fax3         |     email3     |        dato3

4   azienda4      |     via4    |        citta4           |     tel4     |        fax4             |     email4     |        dato4         

5   azienda5      |     via5    |        citta5             |     tel5     |        fax5            |     email5     |        dato5

Ho veramente tanti dati da estrapolare...

Grazie per l'eventuale supporto vorrete gentilmente darmi.

In attesa...saluto.

Answer 1

Scusate non sono stata chiara.

L'errore non me lo da piu in quanto ho trasformato tutte le celle in testo (avevo intuito che Errore di run-time '13': Tipo non corrispondente significasse che il formato non fosse quello corretto.)

Dunque, trasformando tutte le celle in testo la macro funziona ma non da il risultato sperato in quanto mette tutti i dati in una riga sola, cancellandomi anche dei valori. I valori che cancella sono quelli strutturati, nel file originale, in questa maniera

...

Ciao,

ti pare che l'immagine del file che hai allegato sia anche vagamente somigliante alla descrizione fornita nel tuo primo post? La macro è stata persino troppo brava a terminare e fornire un risultato, senza arrabbiarsi più del dovuto.

Mi dispiace, ma da quel poco che posso vedere non credo ci sia soluzione alla tua richiesta.

Andrea.

Answer 2

Grazie ancora per il supporto...

Se fai il passo passo (cioè selezioni la macro e poi inizi a premere il tasto F8), a quale riga vieni portato nel debug?

Grazie.

Answer 3

è successo qualcosa.

In pratica ho trasformato tutte le celle in formato testo.

ho fatto partire la macro e mi ha cambiato tutti i dati, mettendoli in fila, ma cancellando alcune informazioni come il telefono o la mail, cioè le informazioni che sono dopo a tel: oppure email: fax:...

idee?? grazieeeeeeeeeee

Answer 4

Uffa:

Call MsgBox("Si è verificato un errore: " & vbNewLine & _

CStr(Err.Number) & " - " & Err.Description & vbNewLine & vbNewLine & _

r & " - " & sCurrentName & " - " & vbData(r, 1) & " - " & vbData(r, 2), vbCritical, "Error message")

Grazie mille per l'aiuto!!!

Ho provato e mi da il seguente errore

"

Errore di run-time '13':

Tipo non corrispondente

fine | Debug | ?

"

e se facciol il debug mi evidenzia la parte che ho inoltrato...

Grazie ancora per il supporto...

Answer 5

...

Ho veramente tanti dati da estrapolare...

Grazie per l'eventuale supporto vorrete gentilmente darmi.

In attesa...saluto.

Ciao,

prova con la macro allegata da copiare in un modulo generale del file che contiene i dati. Prima di eseguire la macro, modifica nella riga evidenziata il nome del foglio contenente i dati.

Se non hai mai utilizzato il vba, prima di tutto leggi Dove e come inserire il codice VBA.

Andrea.

---

Public Sub SplitDataInColumns()

Dim dicField As Object, dicName As Object    ' Scripting.Dictionary

Dim vbData As Variant, f As Variant

Dim sCurrentName As String

Dim r As Long

On Error GoTo Uffa

'--- set working range

With ThisWorkbook.Worksheets("Foglio1")

r = .Cells(Rows.Count, 1).End(xlUp).Row

vbData = .UsedRange.Resize(r, 2).Value

End With

'--- build unique fields in list

Set dicField = CreateObject("Scripting.Dictionary")

For r = 1 To UBound(vbData)

If Len(vbData(r, 1)) Then dicField(Trim(vbData(r, 1))) = 0

Next

'--- a wrapper for data

Set dicName = CreateObject("Scripting.Dictionary")

'--- make the dictionary case insensitive?

'dicName.CompareMode = vbTextCompare

For r = 1 To UBound(vbData)

If Trim(vbData(r, 1)) = "Nome" Then

sCurrentName = Trim(vbData(r, 2))

'--- add a new record

Set dicName(sCurrentName) = CreateObject("Scripting.Dictionary")

For Each f In dicField

dicName(sCurrentName)(f) = vbNullString

Next

End If

'-- add data fields

If Len(sCurrentName) Then

If dicName.exists(sCurrentName) Then dicName(sCurrentName)(Trim(vbData(r, 1))) = Trim(vbData(r, 2))

End If

Next

'--- paste results

Application.ScreenUpdating = False

With ThisWorkbook.Worksheets.Add()

'--- field names

.[a1].Resize(, dicField.Count).Value = dicField.keys

With Intersect(.UsedRange, Rows(1))

.Font.Bold = True

.HorizontalAlignment = xlCenter

End With

'--- data

r = 1

For Each f In dicName

r = r + 1

.Cells(r, 1).Resize(, dicField.Count).Value = dicName(f).items

Next

With .UsedRange

.Sort [a1], xlAscending, Header:=xlYes

.EntireColumn.AutoFit

End With

End With

exitSub:

'--- clean up

Set dicName = Nothing:  Set dicField = Nothing

Exit Sub

Uffa:

Call MsgBox("Si è verificato un errore: " & vbNewLine & _

CStr(Err.Number) & " - " & Err.Description & vbNewLine & vbNewLine & _

r & " - " & sCurrentName & " - " & vbData(r, 1) & " - " & vbData(r, 2), vbCritical, "Error message")

Resume exitSub

End Sub

---