macro per elaborare dati da un database

[Daniela Daniela]

Ciao Ragazzi,

come sempre sono qui per chiedervi assistenza su una funzione di "riporto" dati che non riesco a elaborare.

Vi spiego cosa devo fare:

Ho un database di 80.000 righe con 10 colonne - la prima colonna ha un valore che richiama il numero di protocollo di un cliente.

Da questo file devo elaborare un file per ogni produttore, che mi riporti esattamente tutte le righe che in colonna 1 hanno il numero produttore che intendo elaborare.

una sorta di cerca.vert su tutta la riga

Vi allego i 2 file (database e file singolo) che riproducano in modo fedele la situazione.

Il file "elaborato" ovviamente deve essere il risultato (con i dati ripresi dal database).

Pensavo si potesse fare richiamando il n. produttore magari inserendolo manualmente come ho fatto nell'esempio nella cella b5

Grazieeeee

[daniela_dpPartecipante daniela_dp]

i file per visualizzare l'esempio

Allegati:

You must be logged in to view attached files.

[Luca73Partecipante Luca73 Karma: 58 pts]

Prova con la Macro qua sotto da inserire in Copia_di_file di_prova.

Le righe con l'indirizzo sono da modificare a tuo uso e consumo

Ciao

Luca

Sub DataBase_Red()
Dim PercorsoDB As String
Dim FileDB As String
Dim DataBASE As Workbook
Dim Prodotti As Range
Dim CellaProd As Range
Dim CellaLav As Range
Dim ProdCercato As String
Dim Index As Integer
ProdCercato = ThisWorkbook.Sheets(1).Range("B5")
Set CellaLav = ThisWorkbook.Sheets(1).Range("A8")
With ThisWorkbook.Sheets(1)
    If .Range("A8") <> "" Then
        Range(CellaLav, .Cells(Rows.Count, 1).End(xlUp).Offset(0, 6)).ClearContents
    End If
End With
PercorsoDB = "C:\Temp\"
FileDB = "Database.xlsx"


Set DataBASE = Workbooks.Open(PercorsoDB & FileDB)
ThisWorkbook.Activate
Set Prodotti = DataBASE.Sheets(1).Range("A1", DataBASE.Sheets(1).Cells(Rows.Count, 1).End(xlUp))
For Each CellaProd In Prodotti
    If CellaProd = ProdCercato Then
        For Index = 0 To 4
            CellaLav.Offset(0, Index) = CellaProd.Offset(0, Index + 1)
        Next
        CellaLav.Offset(0, 5) = CellaProd.Offset(0, 7)
        CellaLav.Offset(0, 6) = CellaProd.Offset(0, 9)
        Set CellaLav = CellaLav.Offset(1, 0)
    End If
Next
Set DataBASE = Nothing

End Sub

[daniela_dpPartecipante daniela_dp]

La macro fa precisamente quello che intendevo GRAZIE!!

Unica cosa, se puoi mi spieghi bene come posso modificare il codice in modo da richiamare solo determinate colonne, piuttosto che altre?

Immagino sia questa parte di codice

For Index = 0 To 4
CellaLav.Offset(0, Index) = CellaProd.Offset(0, Index + 1)
Next
CellaLav.Offset(0, 5) = CellaProd.Offset(0, 7)
CellaLav.Offset(0, 6) = CellaProd.Offset(0, 9)
Set CellaLav = CellaLav.Offset(1, 0)

puoi darmi una dritta su come lavora questo codice in modo da cambiarlo eventualmente??

Scusa l'ignoranza e grazie ancora

[Luca73Partecipante Luca73 Karma: 58 pts]

Ciao ho commentato il codice. fammi sapere se chiaro.

Sub DataBase_Red()
Dim PercorsoDB As String 'definizione variabile percorso del file data base
Dim FileDB As String 'definizione variabile nome del file data base
Dim DataBASE As Workbook 'definizione variabile a cui assegnare il file excel aperto del Dapercorso del file data base
Dim Prodotti As Range 'definizione variabile in cui sara immesso il range dei prodotti in DataBase
Dim CellaProd As Range 'definizione variabile del codice prodotto in Data Base da esaminare 
Dim CellaLav As Range 'definizione variabile della riga nel file di arrivo in lavorazione
Dim ProdCercato As String 'definizione variabile del prodotto da cercare
Dim Index As Integer
ProdCercato = ThisWorkbook.Sheets(1).Range("B5") 'definizione del codice da cercare e inserimento nella variabile
Set CellaLav = ThisWorkbook.Sheets(1).Range("A8") 'immetto nella variabile la posizione dove andrà scritto il primo codice (A8)

With ThisWorkbook.Sheets(1) 
    If .Range("A8") <> "" Then 'verifico se la cella A8 è vuota (ovvero non devo cancellare nulla
        Range(CellaLav, .Cells(Rows.Count, 1).End(xlUp).Offset(0, 6)).ClearContents 'altrimenti cancello i contenuti vecchi parto da A8 e seleziono tutte le celle occupate
    End If
End With
PercorsoDB = "C:\Temp\"
FileDB = "Database.xlsx"
 
 
Set DataBASE = Workbooks.Open(PercorsoDB & FileDB) 'apro il file del data base e lo inserisco in una variabile
ThisWorkbook.Activate 'attivo il file di patenza
Set Prodotti = DataBASE.Sheets(1).Range("A1", DataBASE.Sheets(1).Cells(Rows.Count, 1).End(xlUp)) 'inserisco nella variabile il range dei prodotti che parte da A1 ea riiva fino all'ulima cella occupata
For Each CellaProd In Prodotti 'ciclo sui prodotti in data base
    If CellaProd = ProdCercato Then 'se il prodotto in database è uguale a quelllo cercato
        For Index = 0 To 4
            CellaLav.Offset(0, Index) = CellaProd.Offset(0, Index + 1) 'siccome queste celle sono vicine ho eseguito un ciclo prativcanmet per ogni valore di indice tra 0 e 4 inserisce nalla cella del file di partenza spostata (offset) rispetto a quella di lavoro di 0 righe e Index colonne il valore da data base riga del prodotto in esame con uno spostamento di 0 righe e index +1 colonne (esempio quello che c'è in colonna 3 lo metto in colonna 2
        Next
        CellaLav.Offset(0, 5) = CellaProd.Offset(0, 7) 'siccome le regole cammbiano per i valori dei campi delle colonne 5 e 6 ho inserito queste due righe senza indice. 
        CellaLav.Offset(0, 6) = CellaProd.Offset(0, 9)
        Set CellaLav = CellaLav.Offset(1, 0) ' questa istruzione cambia la cella di lavoro sul file originale e la sposta in sotto di una riga cos' quando andrò a scrivere i nuovi dati li scriverò nella riga sotto 
    End If
Next
Set DataBASE = Nothing
 
End Sub

[daniela_dpPartecipante daniela_dp]

Grazie Luca, gentilissimo.

Ci guardo in mattinata e ti faccio sapere! Per ora ancora grazie e buona giornata

[Luca73Partecipante Luca73 Karma: 58 pts]

Ciao un aiuto molto potente per capire i vari comandi può essere l'help di VBA. posizionandosi su un comando e premendo F1.

[Autore]

Articoli