[Excel] Importare da fogli diversi

[ricky53]

Ciao Ahidai,
prima leggi la soluzione proposta da Anthony.


Ottima domanda Anthony.
Spesso utilizzo software Ocr per convertire in testo delle immagini o dei pdf ma in presenza di tabelle i dati non mi vengono mai così puliti.

Ahidai: che software hai utilizzato per trasformare in testo ciò che avevi ?

[Anthony47]

Io talvolta uso http://www.onlineocr.net, 15 pag /ora gratuite;il risultato e' molto buono (ottimo, per il costo).

Ciao

[ricky53]

Ciao,
io utilizzo ABBY Fine Reader 8 che ho avuto acquistando lo scanner.
E' molto buono per i testi però con alcune tabelle sfarfalla.
Si ho utilizzato anche quello che hai indicato tu ma stesso sfarfallamento ... certo erano tabelle particolari alla fine ho fatto prima a rifarle in excel e poi a copiarle in word.

[ahidai]

Ciao a tutti, allora come dicevo nei post precedenti avevo dei files in pdf e li ho convertiti come indicato da Anthony con http://www.onlineocr.net e devo confermare che è stata un'ottima soluzione, adesso provo la soluzione proposta da Anthony e vi farò sapere.
Ciao e buona giornata.

[ahidai]

[Se ti da fastidio, allora puoi sostituire gli "Alt-Enter" su tutto il foglio unificato con un codice come questo:

Codice: Seleziona tutto

For Each Cell In ActiveSheet.UsedRange
Cell.Value = Replace(Cell.Value, Chr(10), " ")
Next Cell


Va eseguito avendo come foglio attivo il foglio unificato; poi formatti le colonne e i testi a piacimento.

Ciao[/quote]

Non riesco a capire dove inserire questo codice nella macro. Hep Me.
Grazie

[ricky53]

Ciao,
il codice di Anthony lo puoi inserire, nella macro che ti ho invaito e che tu hai utilizzato per riunire i file, prima di questa istruzione

Codice: Seleziona tutto

    MsgBox "Sono stati COPIATI i dati di   '" & I & "'   file" & Chr(10) & Chr(10) & _
        "presenti nel percorso:  '" & MioPercorso & "'"

[Anthony47]

Vedi la risposta di Ricky sopra.
Mi dici anche quale stampante vrtuale hai usato per creare i 200 jpg?

Ciao

[ahidai]

Ciao,
il codice di Anthony lo puoi inserire, nella macro che ti ho invaito e che tu hai utilizzato per riunire i file, prima di questa istruzione

Codice: Seleziona tutto

    MsgBox "Sono stati COPIATI i dati di   '" & I & "'   file" & Chr(10) & Chr(10) & _
        "presenti nel percorso:  '" & MioPercorso & "'"

Ciao ho inserito il codice quà:

Codice: Seleziona tutto

    Application.ScreenUpdating = True

    For Each Cell In ActiveSheet.UsedRange
    Cell.Value = Replace(Cell.Value, Chr(10), " ")
    Next Cell

        MsgBox "Sono stati COPIATI i dati di   '" & I & "'   file" & Chr(10) & Chr(10) & _
        "presenti nel percorso:  '" & MioPercorso & "'"
End Sub


ma mi da errore di compilazione variabile non definita e si evidenzia Cell.
Per Anthony ho usato la stampante virtuale pdf poi ho aperto i files e li ho esportati come immagine in jpg.
Grazie e ciao a tutti.

[Anthony47]

Hai usato Option Explicit, quindi le variabili vanno dichiarate prima del loro uso.
Inserisci Dim Cell subito prima della riga che ti va in errore.

Ciao

[ahidai]

Hai usato Option Explicit, quindi le variabili vanno dichiarate prima del loro uso.
Inserisci Dim Cell subito prima della riga che ti va in errore.

Ciao

Funziona!!!! Un grazie a Ricky e Anthony che hanno avuto una pazienza fuori dal comune.
metto a disposizione il codice:

Codice: Seleziona tutto

Option Explicit
Public MioFile As String, MioPercorso As String, Wb1 As String, Wb2 As String, UR As Integer

Sub Leggi_File()
    Dim I As Integer
    I = 0
    Application.ScreenUpdating = False
    Foglio1.Select
    [A1] = "MAT."
    [B1] = "NR."
    [C1] = "DOMANDA"
    [D1] = "A"
    [E1] = "B"
    [F1] = "C"
    [G1] = "D"

    MioPercorso = "C:\ \" ' << -------------- QUI devi inserire il tuo percorso
    MioFile = Dir(MioPercorso & "*.xls") ' << -------------- Il file che esegue questa macro non deve stare nella stessa cartella dove ci sono i files da importare
    Do While MioFile <> ""
        I = I + 1
       
        Copia_Dati
       
        MioFile = Dir()
    Loop

    Columns("A:A").ColumnWidth = 5
    Columns("B:B").ColumnWidth = 4
    Columns("C:C").ColumnWidth = 45
    Columns("D:D").ColumnWidth = 40
    Columns("E:E").ColumnWidth = 40
    Columns("F:F").ColumnWidth = 40
    Columns("G:G").ColumnWidth = 40
   
    Columns("C:G").Select
    With Selection
        .VerticalAlignment = xlTop
        .WrapText = True
    End With
    [A1].Select
   
    Application.ScreenUpdating = True
    Dim Cell
    For Each Cell In ActiveSheet.UsedRange
    Cell.Value = Replace(Cell.Value, Chr(10), " ")
    Next Cell
    MsgBox "Sono stati COPIATI i dati di   '" & I & "'   file" & Chr(10) & Chr(10) & _
        "presenti nel percorso:  '" & MioPercorso & "'"
End Sub

Sub Copia_Dati()
    Dim Matr1(1 To 7) As Integer
    Wb1 = ActiveWorkbook.Name
    Workbooks.Open Filename:=MioPercorso & MioFile
    Wb2 = ActiveWorkbook.Name
    UR = Range("A" & Rows.Count).End(xlUp).Row
       
    Range("A2", Cells(UR, 7)).Copy
    Windows(Wb1).Activate
    Sheets("Foglio1").Select
    UR = Range("A" & Rows.Count).End(xlUp).Row + 1
    Range("A" & UR).Select
    Selection.PasteSpecial Paste:=xlPasteValues
   
    Windows(Wb2).Activate
    Application.DisplayAlerts = False
    ActiveWindow.Close
    Application.DisplayAlerts = True
    Windows(Wb1).Activate
   
    With Selection
        .VerticalAlignment = xlTop
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlTop
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

End Sub

Un ciao a tutti.

[christianghz]

Ciao a tutti!
Intanto complimenti, questa macro è speciale!

Ho però una difficoltà aggiuntiva da sottoporvi.. faccio un esempio pratico così mi spiego meglio!

Ho 10 clienti che mi chiedono ogni giorno di fargli una spedizione, e per farlo mi inviano un file excel con all'interno i vari campi:

Cliente:...
Luogo ritiro: ....
Luogo Consegna: ......
Note consegna: ......
(ma anche numero bolla, sponda si/no, preavviso telefonico si/no, ecc ecc ecc)

1° tipo plt: ALTEZZA LUNGHEZZA LARGHEZZA PESO NUMERO PLT
2° tipo plt: ALTEZZA LUNGHEZZA LARGHEZZA PESO NUMERO PLT.
3° tipo plt: ALTEZZA LUNGHEZZA LARGHEZZA PESO NUMERO PLT
4° tipo plt: ALTEZZA LUNGHEZZA LARGHEZZA PESO NUMERO PLT
e stop.

Con questa macro vorrei riunire tutti i dati dei vari file in un unico file che riporterà l'elenco delle spedizioni con i dati divisi per colonna:


CLIENTE LUOGORIT LUOGOCONS NOTECONS ...(nbolla,sponda,ecc).... ALTEZZA LUNGHEZZA LARGHEZZA PESO NUMEROPLT


Ora, il problema è questo:
quando il cliente in una spedizione ha più di 2 plt di tipo diverso, ho bisogno che il file crei 2 righe, con le stesse identiche voci, ma nella prima riga le dimensioni del primo tipo di pallet e il relativo numero, e nella seconda riga le dimensioni del secondo tipo di pallet e il relativo numero.

Si può fare?


Grazie in anticipo!

[ricky53]

Ciao,
sul file di "Input" i dati come sono organizzati?

Nel caso che hai esposto quante righe hai sul file di "Input" ?

Conclusione: uno o due file sarebbero molto utili ... attenzione ai dati riservati !

[christianghz]

Ecco qua il link!

Nel foglio 1 c'è il modulo che mi manda il cliente con i vari dati.
Nel foglio 2 il file riepilogativo, ovvero come verrebbero riordinati i dati in colonne (spero di non aver saltato nessun dato).


In questo caso specifico ci sono 3 bancali, 2 identici e un terzo di dimensioni diverse.
A me serve che per questa spedizione nel foglio 2 riepilogativo mi vengano fuori 2 righe con i dati identici,
ma la prima riga con le misure del primo tipo di pallet, la seconda riga con le misure del socondo tipo di pallet.

se nel tipo di pallet 3 e 4 non è indicato nulla non deve riportare nessun dato.


http://rapidshare.com/share/7F510C01033 ... A6CBC6DEDA

grazie!

[ricky53]

ciao,
non hai compilato il foglio "file riepilogativo" riportando i dati che vorresti avere.

Il file deve essere esaustivo delle effettive condizioni che hai altrimenti non è di aiuto.

invia uno nuovo file compilandolo con i dati effettivi

[christianghz]

chiedo scusa!
eccolo!

http://rapidshare.com/share/E23759BF26D ... 5C75EB12AC

[ricky53]

Ciao,
anche in questo file non hai compilato il foglio "file riepilogo" !!!

[christianghz]

mmmm... riprovo

http://rapidshare.com/share/225F658B84E ... FB57FE6E63

[ricky53]

Ciao,
bene il file adesso è completo.
Mi serviva la conferma che quanto avevo capito fosse proprio quello che ti occorreva.
La conferma l'ho avuta.
Riepilogando per ogni ordine si avranno al massimo "4" righe quanti sono le righe dedicate ai "Tipi di pallet" inseribili nell'ordine.

Vedo cosa possa fare ... a presto.

[ricky53]

Ciao,
tu hai già una macro con la quale hai cominciato a copiare i dati dal file ordini al file riepilogativo?

[ricky53]

Ciao,
prova questo codice che copia i dati dal foglio "Richiesta Ritiro" del file attivo su un file "riepilogativo" che viene aperto automaticamente dalla macro.

Attenzione nel file "Riepilogativo" hai invertito larghezza del pallet con lunghezza: controlla !

Codice: Seleziona tutto

Option Explicit

Sub Copia_Dati()
    Dim XX As Integer, U_Riga As Long, MioPercorso As String, MioFile As String, Wb1 As Workbook, Wb2 As Workbook
    Dim WS1 As Worksheet, WS2 As Worksheet
   
    MioPercorso = "D:\NOME DEL PERCORSO OVE HAI IL FILE DA APRIRE"
    MioFile = "NOME DEL FILE DA APRIRE" & ".xls"
   
    Set Wb1 = ActiveWorkbook
    Set WS1 = Wb1.Sheets("Richiesta Ritiro")
   
    Workbooks.Open Filename:=MioPercorso & "\" & MioFile
    Set Wb2 = ActiveWorkbook
    Set WS2 = Wb2.Sheets("Riepilogativo")
    U_Riga = WS2.Range("A" & Rows.Count).End(xlUp).Row + 1
   
       
    With WS2
        .Cells(U_Riga, "A") = WS1.Range("B4")
        .Cells(U_Riga, "B") = WS1.Range("B5")
        .Cells(U_Riga, "C") = WS1.Range("B6")
        .Cells(U_Riga, "D") = WS1.Range("G5")

' . . .
' . . . QUI INSERISCI LE ALTRE ISTRUZIONI per impostare le colonne "E-R" del foglio "Riepilogativo"
' . . .
   
' Dati dei Pallets
        .Cells(U_Riga, "S") = WS1.Range("E25")
        .Cells(U_Riga, "T") = WS1.Range("C25")
        .Cells(U_Riga, "U") = WS1.Range("G25")
        .Cells(U_Riga, "V") = WS1.Range("I25")
        .Cells(U_Riga, "W") = WS1.Range("K25")
        .Cells(U_Riga, "Y") = WS1.Range("M25")
       
' Contrassegno
        .Cells(U_Riga, "X") = WS1.Range("C20")
       
' EVENTUALI Dati degli altri pallets
        For XX = 27 To 31 Step 2
            If WS1.Range("C" & XX) <> "" Then
                .Range("A" & U_Riga & ":Y" & U_Riga).Copy Destination:=.Range("A" & U_Riga + 1)
                .Cells(U_Riga + 1, "S") = WS1.Range("E" & XX)
                .Cells(U_Riga + 1, "T") = WS1.Range("C" & XX)
                .Cells(U_Riga + 1, "U") = WS1.Range("G" & XX)
                .Cells(U_Riga + 1, "V") = WS1.Range("I" & XX)
                .Cells(U_Riga + 1, "W") = WS1.Range("K" & XX)
                .Cells(U_Riga + 1, "Y") = WS1.Range("M" & XX)
                U_Riga = U_Riga + 1
            Else
                Exit For
            End If
        Next XX
    Wb2.Save
    Wb2.Close
    End With
   
    MsgBox "Effettuata la copia dei dati della spedizione n.  '" & WS1.Range("G5") & "'"

    Set Wb1 = Nothing
    Set Wb2 = Nothing
    Set WS1 = Nothing
    Set WS2 = Nothing
End Sub


Se hai altre modalità per la gestione dei file comunicalo e troveremo la soluzione.