rielaborazione foglio excel

Hai un problema con Excel?

Nuova discussione

rielaborazione foglio excel
di michela (utente non iscritto) data: 03/07/2017 11:48:16
Ciao ragazzi!
Avrei bisogno delle vostre grandi capacità in vba, per rielaborare un foglio con oltre 9000 articoli di elenco prezzo e trasformarlo in una tabella con delle colonne assegnate.
In particolare, allego un file dove nel foglio 1 si trova un estratto dell'elenco che mi viene fornito e nel foglio 2 la tabella di come dovrei trasformarlo.
Ho lavorato un bel po' con i comandi di Excel ma alla fine diventa molto pensante con 9000 voci...vero che vba potrebbe venirmi in soccorso??
Grazie molte a chi potrà aiutarmi.
di Vecchio Frac data: 03/07/2017 11:55:38
Sembra un prezziario per un DUVRI :)

Credo che VBA potrà aiutare, quello che non aiuta è il fatto di avere le colonne unite, inoltre spezzare le righe ai salti pagina è un ostacolo (per esempio E17 continua su E32 vero?).
Il lavoro è certosino e non vedo una regolarità tranne il poter intercettare i cambi codice per stabilire quando una descrizione termina.

Tu non hai realizzato alcun pezzo di codice per impostare il lavoro?
di alfrimpa data: 03/07/2017 12:06:18
Ciao Michela

Anche con il VBA la vedo dura, molto dura.

La tua base dati (foglio1) è molto "scombinata".

Ci sono molte celle unite (che non vanno molto d'accordo con il VBA) e poi in molte celle vi sono testi molto lunghi che tu vuoi suddividere oltre a molte righe vuote.

Il problema è trovare un criterio univoco con cui suddividere i testi.

Tu hai parlato di articoli ma nel foglio1 articoli non ne vedo; si parla di lavori, scavi etc.

Alfredo
di alfrimpa data: 03/07/2017 12:12:01
V.F. cosa è un DUVRI?

Comunque, sia pure con parole diverse, abbiamo espresso, più o meno, gli stessi concetti.

Alfredo
di michela (utente non iscritto) data: 03/07/2017 12:16:24
in effetti è un prezzario tecnico x computi metrici...il problema è che ho solo un pdf dell'originale e lo devo rielaborare per i nostri utilizzi...ma a mano temo di metterci 2 anni
Sì le celle vanno unite talvolta fra due pagine. e non ho elaborato codici funzionanti perché è la prima volta che devo trascrivere su un secondo foglio..ma non lo so fare..
la mia idea era cmq un codice che quando trova libera la cella nella colonna D del foglio 1, copia tutta la riga nel foglio 2..
di alfrimpa data: 03/07/2017 12:30:55
Cit. "la mia idea era cmq un codice che quando trova libera la cella nella colonna D del foglio 1, copia tutta la riga nel foglio 2"

Beh dall'esempio che hai fatto nel foglio2 non mi sembra proprio così.

Su foglio2 tu hai "Descrizione breve" e "Descrizione estesa"; sul foglio1 hai solo "Descrizione".

In base a quale criterio va suddiviso "Descrizione"?

Alfredo
di Vecchio Frac data: 03/07/2017 13:25:51
@Alfri
--> per come ho capito io, per esempio relativamente al codice A.01.003 (che è suddiviso in ulteriori sottocodici e quindi per tutti i suoi sottocodici) tu hai una descrizione breve da ricavare da "MOVIMENTI DI MATERIA E DEMOLIZIONI
SCAVI
SCAVO DI SBANCAMENTO IN ROCCIA DURA DA MINA
- DI CUBATURA SUPERIORE A MC 1,00"
la descrizione breve sarebbe dopo il primo trattino cioè "- DI CUBATURA SUPERIORE A MC 1,00", altrimenti coincide con la terza riga della descrizione come ad es. in A.01.001: "MOVIMENTI DI MATERIA E DEMOLIZIONI
SCAVI
SCAVO DI SBANCAMENTO IN MATERIA DI QUALSIASI NATURA"
diventa "SCAVO DI SBANCAMENTO IN MATERIA DI QUALSIASI NATURA" lasciando come descrizione lunga l'intera descrizione del foglio1.
Non ho guardato a fondo tutta la casistica.
Si complica ulteriormente perchè le unità di misura e i prezzi sono giù di una riga.
Quindi va analizzata la colonna codici e finchè ci sono colonne a destra compilate, va tutto riferito al codice trovato in precedenza.

(un DUVRI è un documento di valutazione dei rischi da interferenze che si compila quando ci sono imprese terze che per eseguire lavori o fornire servizi devono accedere ai loghi di lavoro del committente e quindi ci sono interferenze con le attività, per cui vengono computati costi relativi agli apprestamenti per la sicurezza sul lavoro)
di michela (utente non iscritto) data: 03/07/2017 13:38:26
esatto Vecchio Frac...hai centrato il discorso...
Se mi dite che così è troppo complicato, però, si potrebbe almeno convertire l'elenco in tabella (quindi togliendo le intestazioni, i numeri pagina, i titoli ecc) riportando la descrizione del foglio 1 nella colonna DescEstesa del foglio 2 così com'è (evitando quindi la suddivisione dei titoli...x quello ci penso dopo)?

di alfrimpa data: 03/07/2017 13:55:21
Intanto, ma è solo un timido tentativo, potresti provare la macro che vedi sotto tenendo presente che sul foglio2 la colonna descrizione deve essere unica

CodiceArticolo DescEstesa UnitaDiMisura PrezzoUnitario

Alfredo

Sub prova()
Dim rng As Range
Dim cel As Range
Dim LR As Long
Dim ur As Long
LR = Sheets("Foglio1").Cells(Rows.Count, 3).End(xlUp).Row
Set rng = Sheets("Foglio1").Range("C10:C" & LR)
For Each cel In rng
ur = Sheets("Foglio2").Cells(Rows.Count, 1).End(xlUp).Row
If cel.Value <> "" And cel.Value <> "Codice" Then
    Sheets("Foglio2").Cells(ur + 1, 1) = cel.Value
    Sheets("Foglio2").Cells(ur + 1, 2) = cel.Offset(0, 1).Value
    Sheets("Foglio2").Cells(ur + 1, 3) = cel.Offset(1, 5).Value
    Sheets("Foglio2").Cells(ur + 1, 4) = cel.Offset(1, 6).Value
End If
Next cel
End Sub

di michela (utente non iscritto) data: 03/07/2017 14:27:20
Fantastico Alfredo, grazie...è già un ottimo risultato!
Nel foglio 2 che ottengo, devo però evitare che vi siano righe vuote fra i vari articoli. Posso aggiungere un'istruzione prima della chiusura della sub?
Altro passo sarebbe controllare che nel foglio 1 non vi siano descrizioni senza codice nella colonna D: in questo caso andrebbe riportata la sola descrizione nel foglio 2.
Poi il resto spero di riuscire ad affinarlo io in qualche modo...però grazie intanto del prezioso aiuto!!!

di alfrimpa data: 03/07/2017 14:47:17
Michela prova con questa.

Alfredo

Sub prova()
Dim i As Integer
Dim uRiga As Integer
Dim rng As Range
Dim cel As Range
Dim LR As Long
Dim ur As Long
Application.ScreenUpdating = False
LR = Sheets("Foglio1").Cells(Rows.Count, 3).End(xlUp).Row
Set rng = Sheets("Foglio1").Range("C10:C" & LR)
For Each cel In rng
ur = Sheets("Foglio2").Cells(Rows.Count, 1).End(xlUp).Row
If cel.Value <> "" And cel.Value <> "Codice" Then
    Sheets("Foglio2").Cells(ur + 1, 1) = cel.Value
    Sheets("Foglio2").Cells(ur + 1, 2) = cel.Offset(0, 1).Value
    Sheets("Foglio2").Cells(ur + 1, 3) = cel.Offset(1, 5).Value
    Sheets("Foglio2").Cells(ur + 1, 4) = cel.Offset(1, 6).Value
End If
Next cel
uRiga = Sheets("Foglio2").Cells(Rows.Count, 1).End(xlUp).Row
For i = uRiga To 2 Step -1
 If Left(Range("a" & i).Value, 1) <> "A" Then
    Range("a" & i).EntireRow.Delete
 End If
Next i
Application.ScreenUpdating = True
End Sub

di michela (utente non iscritto) data: 03/07/2017 14:57:28
Grazie Alfredo.
Mi pare, però, che questa istruzione limiti la trascrizione sul foglio 2 dei soli codici che iniziano con la A.
In realtà vanno dalla A alla S, anche se ho riportato solo A. e B. nel foglio 1.
If Left(Range("a" & i).Value, 1) <> "A"

di michela (utente non iscritto) data: 03/07/2017 15:05:09
una cosa del genere, che però non funziona.....che dici??

Sub elimina_righe()
Dim Intervallo As Range
Dim Righe, R, Colonne, C, FL As Boolean
Sheets("Foglio2").Select
Set Intervallo = ActiveSheet.UsedRange
Righe = Intervallo.Rows.Count
Colonne = Intervallo.Columns.Count
For R = Righe To 1 Step -1 ' questo è il ciclo modificato
FL = False
For C = 1 To Colonne
If Intervallo(R, C) <> "" Then
FL = True
End If
Next
If FL = False Then
Intervallo(R, 1).EntireRow.Delete
End If
Next
End Sub

di alfrimpa data: 03/07/2017 15:15:21
Se il secondo carattere del codice è sempre il "." prova con questa

Alfredo

Sub prova()
Dim i As Integer
Dim uRiga As Integer
Dim rng As Range
Dim cel As Range
Dim LR As Long
Dim ur As Long
Application.ScreenUpdating = False
LR = Sheets("Foglio1").Cells(Rows.Count, 3).End(xlUp).Row
Set rng = Sheets("Foglio1").Range("C10:C" & LR)
For Each cel In rng
ur = Sheets("Foglio2").Cells(Rows.Count, 1).End(xlUp).Row
If cel.Value <> "" And cel.Value <> "Codice" Then
    Sheets("Foglio2").Cells(ur + 1, 1) = cel.Value
    Sheets("Foglio2").Cells(ur + 1, 2) = cel.Offset(0, 1).Value
    Sheets("Foglio2").Cells(ur + 1, 3) = cel.Offset(1, 5).Value
    Sheets("Foglio2").Cells(ur + 1, 4) = cel.Offset(1, 6).Value
End If
Next cel
uRiga = Sheets("Foglio2").Cells(Rows.Count, 1).End(xlUp).Row
For i = uRiga To 2 Step -1
 If Mid(Range("a" & i).Value, 2, 1) <> "." Then
    Range("a" & i).EntireRow.Delete
 End If
Next i
Application.ScreenUpdating = True
End Sub

di michela (utente non iscritto) data: 03/07/2017 15:40:01
Alfredo, quest'ultima mi cancella un po' di articoli A dal foglio 1
di alfrimpa data: 03/07/2017 15:40:53
Allora cerchiamo di trovale un'altra strada.

Prutroppo nel foglio1 sono rimaste "schifezze" dalla conversione del PDF e celle che sembrano vuote non lo sono e questo causa l'inserimento di righe vuote sul foglio2.

Dovresti farmi sapere tutte le possibili iniziali del Codice; vanno dalla A alla S?

Alfredo

di michela (utente non iscritto) data: 03/07/2017 16:36:08
queste le lettere dei codici seguite dal "." A, B, C, CE, D, E, F, G, H, I, IG, IT, L, M, O, P, Q, R, SL, SIC, T.
Scusa se chiedo: visto che il codice sotto funzionava, salvo lasciare righe bianche, non conviene lasciarlo girare e poi, nel foglio 2, far girare un'altra macro che riconosce più facilmente le celle vuote?

Sub prova()
Dim i As Integer
Dim uRiga As Integer
Dim rng As Range
Dim cel As Range
Dim LR As Long
Dim ur As Long
Application.ScreenUpdating = False
LR = Sheets("Foglio1").Cells(Rows.Count, 3).End(xlUp).Row
Set rng = Sheets("Foglio1").Range("C10:C" & LR)
For Each cel In rng
ur = Sheets("Foglio2").Cells(Rows.Count, 1).End(xlUp).Row
If cel.Value <> "" And cel.Value <> "Codice" Then
    Sheets("Foglio2").Cells(ur + 1, 1) = cel.Value
    Sheets("Foglio2").Cells(ur + 1, 2) = cel.Offset(0, 1).Value
    Sheets("Foglio2").Cells(ur + 1, 3) = cel.Offset(1, 5).Value
    Sheets("Foglio2").Cells(ur + 1, 4) = cel.Offset(1, 6).Value
End If
Next cel
uRiga = Sheets("Foglio2").Cells(Rows.Count, 1).End(xlUp).Row
For i = uRiga To 2 Step -1
 If Left(Range("a" & i).Value, 1) <> "A" Then
    Range("a" & i).EntireRow.Delete
 End If
Next i
Application.ScreenUpdating = True
End Sub

di alfrimpa data: 03/07/2017 16:48:27
No Michela

Il problema è che vi sono celle che sembrano vuote che non lo sono.

Comunque mi è venuta in idea.......

Alfredo
di alfrimpa data: 03/07/2017 19:24:15
Michela purtroppo penso di averle provate tutte ma non riesco ad aiutarti.

Il foglio1 è troppo incasinato.

Penso che tu debba eliminare a mano le righe vuote nel foglio2.

Semprechè Vecchio Frac (o altri) non riescano a tirar fuori il coniglio dal cilindro

Alfredo
di Vecchio Frac data: 03/07/2017 20:28:02
Io ti ho lasciato fare perchè altrimenti sembra sempre che mi intrometto ^_^
Però posso provarci ugualmente, che ne dite?
di alfrimpa data: 03/07/2017 21:40:17
Mica devi chiedere il permesso

Sicuramente troverai la soluzione.

Alfredo
di alfrimpa data: 03/07/2017 21:56:03
V.F. io sono riuscito nel lavoro solo a metà.

Il problema è che sul foglio2 ci sono righe vuote che vuote non sono perchè contengono caratteri non visibili/non stampabili che non riesco ad intercettare e quindi non riesco ad eliminare quelle righe.

Alfredo
di Vecchio Frac data: 03/07/2017 22:12:01
Proverò con Worksheetfunction.Clear e Trim() per eliminare i caratteri non stampabili ^_^
di alfrimpa data: 03/07/2017 22:23:36
"Libera" accidenti a te

Alfredo
di michela (utente non iscritto) data: 04/07/2017 08:49:36
Grazie ragazzi! Per tutto l'impegno che ci state mettendo per aiutarmi!!
di alfrimpa data: 04/07/2017 14:30:12
Niente; anche con la funziona LIBERA() che serve ad eliminare i caratteri non visibili/stampabili no riesco a risolvere.

la funzione VAL.VUOTO() che serve a verificare se una cella è vuota o meno mi restituisce sempre FALSO.

Le ho provate di tutte.

Alfredo

di Vecchio Frac data: 04/07/2017 15:40:39
Allora ecco qui una proposta.
Ammetto che è un po' incasinata :)
Forse ci sono ancora variabili spurie che vanno tolte di mezzo.
Sull'esempio fornito funziona abbastanza bene ma non benissimo, c'è ancora qualcosa da aggiustare (il tempo è sempre tiranno purtroppo). Diciamo che al 90% offre un risultato accettabile.
Il lavoro come dicevo comporta una certa pazienza nell'esaminare le singole celle. Il fatto che ci siano celle unite (frutto dell'import dal pdf) non aiuta anzi è un vero ostacolo.
Comunque provate e ditemi (ripeto: si dovrebbe aggiustare ancora).

Option Explicit

Sub processing()
Dim dict As Object, re As Object
Dim ac As Range, c As Range, cel As Range
Dim s As String
Dim i As Long, iRow As Long, j As Long
Dim v As Variant, o As Variant
Dim last_address As String
Dim codice As String, desc_breve As String, desc_estesa As String, u_m As String, prezzo As String

    Sheets("Foglio2").Range("A2:E5000").ClearContents
    Sheets("Foglio1").Select
    
    Set dict = CreateObject("Scripting.Dictionary")
        
    Set re = CreateObject("VBScript.RegExp")
    re.Global = True
    re.IgnoreCase = False        'ignore case

    'Codici ammessi: A, B, C, CE, D, E, F, G, H, I, IG, IT, L, M, O, P, Q, R, SL, SIC, T.
    re.Pattern = "(?:C[AE]).|(?:I[GT]).|SL.|SIC.|[ABCDEFGHILMOPQRT]."
     
    For Each ac In Range("C:C").SpecialCells(xlCellTypeConstants)
        If re.test(ac) Then
            s = Trim(ac)
            i = i + 1
            dict.Add i, Array(s, ac.Address)       'dict(i) = contenuto cella, indirizzo cella
        End If
    Next
    dict.Add i + 1, Array("FINE", Range(dict(i)(1)).Offset(10).Address)
    
    iRow = 2
    For j = 1 To i
        
        Set c = Range(Range(dict(j)(1)), Range(dict(j + 1)(1)).Offset(-1, 6))
        
        codice = dict(j)(0)
        
        s = ""
        For Each cel In c.Columns(3).Cells
            If cel.MergeArea.Count = 4 And LCase(cel) <> "descrizione" Then
                If Trim(cel) <> "" Then
                    s = s & Trim(cel) & vbCrLf
                    last_address = cel.Address
                End If
            End If
        Next
        desc_estesa = s
        
        o = Split(desc_estesa, vbLf)
        If Right(codice, 1) Like "[0-9]" Then
            desc_breve = o(2)
        Else
            desc_breve = o(3)
        End If
        
        u_m = Range(last_address).Offset(1, 1)
        If u_m = "" Then
            u_m = Join(Application.Transpose(c.Columns(7)))
            u_m = Trim(u_m)
            u_m = Trim(Replace(u_m, "U.M.", ""))
        End If
        
        prezzo = Range(last_address).Offset(1, 2)
        If prezzo = "" Then
            prezzo = Join(Application.Transpose(c.Columns(8)))
            prezzo = Trim(prezzo)
            prezzo = Trim(Replace(prezzo, "PREZZO", ""))
        End If
        
        With Sheets("Foglio2")
            .Cells(iRow, "A") = codice
            .Cells(iRow, "B") = desc_breve
            .Cells(iRow, "C") = desc_estesa
            .Cells(iRow, "D") = u_m
            .Cells(iRow, "E") = prezzo
        End With
        
        iRow = iRow + 1
    Next
    
    Sheets("Foglio2").Select
    Cells.WrapText = False
    Range("A1").Select

    MsgBox "Finito!", vbInformation
End Sub

di michela (utente non iscritto) data: 04/07/2017 16:39:31
Vecchio Frac sei un mito!! Hai risolto un problema complicatissimo con una macro che nel giro di qualche secondo mi converte 9000 dati in tabella...mai avrei pensato tanto!!
A questo livello ci posso lavorare anch'io, ma intanto un doveroso GRAZIEEEE!!!!
di alfrimpa data: 04/07/2017 16:43:16
Anche da parte mia i complimenti a Vecchio Frac veramente di gran classe.

Alfredo
di Vecchio Frac data: 04/07/2017 16:53:47
Bè ma troppo buoni,
@Michela non fidarti completamente ci son sicuramente cose da aggiustare!
@Alfri non è certamente un codice scritto bene (comunque grazie ^_^)
di alfrimpa data: 04/07/2017 19:45:31
Ma stai scherzando V.F.?

Il codice che hai scritto è di gran classe e lo hai steso in poco tempo nei ritagli del tuo lavoro.

Io non ci sarei riuscito neanche in tre anni

Complimenti davvero.

Alfredo

P.S. Sarebbe utile se ti riattribuissi la qualifica di "Moderatore" o, al limite di "Utente Esperto", in modo che ci si possa incontrare in Area51. Chiedo scusa a Michela per l'O.T.
di Vecchio Frac data: 04/07/2017 20:53:33
Le celle sembravano vuote ma contenevano spazi singoli.
Con .Clean (=LIBERA) non vengono puliti gli spazi in eccesso, con Trim() cioè =ANNULLA.SPAZI sì.

In realtà l'unica cosa che mi piace molto di quel codice è la regex ^_^
Sul rivedersi in Area51 in effetti è vero, così non posso entrarci.
Però ho modo comunque di vedere gli eventuali messaggi se ve ne sono :)

Vuoi Approfondire?