| | Post: 46 | Registrato il: 30/06/2016
| Città: MILANO | Età: 48 | Utente Junior | 2013 | | OFFLINE | |
|
  20/03/2018 13:14 | |
ciao
sapete aiutarmi a creare una formula o una macro per fare questo:
A un nome file corrispondono più descrizioni a seconda del codice di appartenenza.
devo creare un censimento di migliaia di nomi file.associando a ogni descrizione del nome file a seconda del codice di appartenenza.
allego foglio xls con esempio e dove si capisce meglio la richiesta.
grazie
Claudio |
|
| | Post: 5.354 | Registrato il: 14/11/2004
| Utente Master | Office 2019 | | OFFLINE |
|
| 20/03/2018 16:32 | |
Ciao Luinetti, eccoti una macro che fa il lavoro, ma ha bisogno di un poco di preparazione, nel senso bisogna stabilire le colonne per i Codici e nel caso siano di più di questo esempio bisogna allungare le colonne peri codici.
La prima cosa che ho fatto è stato ricavare questi codici dal menu->dati Filtro avanzato "Copia univoca dei record" li ho fatti inserire nella colonna "AA" come puoi vedere dal file allegato dopo aver fatto l'ordinamento di fianco ho scritto il numero di colonna dove li ho copiati con Copia/incolla trasponi partendo dalla colonna 2 del foglio "da Compilare", questa la preparazione da effettuare prima di lanciare questa macro che fa il lavoro.
Sub Dividi()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim R, c, x, y, z, d, RngD, RngC
Set Sh1 = Worksheets("da compilare")
Set Sh2 = Worksheets("Foglio dati")
Sh1.Activate
If Cells(2, 1) = "" Then R = 2 Else R = Sh1.Cells(Rows.Count, 1).End(xlUp).Row
Sh1.Range("A2:AA" & R).ClearContents
R = Sh2.Cells(Rows.Count, 1).End(xlUp).Row
RngD = Sh2.Range("A2:C" & R)
R = Sh2.Cells(Rows.Count, 27).End(xlUp).Row
RngC = Sh2.Range("AA2:AB" & R)
R = 1
For x = 1 To UBound(RngD)
d = RngD(x, 2)
If d <> "" Then
R = R + 1
Sh1.Cells(R, 1) = d
For y = x To UBound(RngD)
If y + 1 > UBound(RngD) Then x = y: Exit For
If RngD(y + 1, 2) <> "" Then x = y: Exit For
For z = 1 To UBound(RngC)
If RngD(y, 1) = RngC(z, 1) Then c = RngC(z, 2): Exit For
Next z
Sh1.Cells(R, c) = RngD(y, 3)
Next y
End If
Next x
End Sub la macro la prima cosa cancella i dati vecchi fino alla colonna "AA" e poi trascrive i nuovi dati ricavandoli dal "foglio dati".
Non ho fatto inserire "Non Presente" dove manca il codice, credo che basti la cella vuota.
Ciao By Sal ![[SM=x423051]](http://www.erismag.it/Servizio/ForumExcel/Smiles/Faccina_0031.gif)
[Modificato da by sal 20/03/2018 16:35] se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui |
| | Post: 46 | Registrato il: 30/06/2016
| Città: MILANO | Età: 48 | Utente Junior | 2013 | | OFFLINE | |
|
| 21/03/2018 10:56 | |
ciao by sal
sei stato bravissimo, mi aiuta molto questa macro.
ma qualcosa non funziona bene.
ad esempio il primo file ALCD100T non lo inserisce su T88 del foglio "da compilare" seppure è presente nel "foglio dati".
grazie ancora
Claudio |
| | Post: 5.355 | Registrato il: 14/11/2004
| Utente Master | Office 2019 | | OFFLINE |
|
| 21/03/2018 14:36 | |
Ciao Claudio, in effetti hai ragione ce un errore nella macro, facevo il controllo prima che finiva di scrivere tutto il file, sostituisci la macro con questa.
Sub Dividi()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim R, c, x, y, z, d, RngD, RngC
Set Sh1 = Worksheets("da compilare")
Set Sh2 = Worksheets("Foglio dati")
Sh1.Activate
If Cells(2, 1) = "" Then R = 2 Else R = Sh1.Cells(Rows.Count, 1).End(xlUp).Row
Sh1.Range("A2:L" & R).ClearContents
R = Sh2.Cells(Rows.Count, 1).End(xlUp).Row
RngD = Sh2.Range("A2:C" & R)
R = Sh2.Cells(Rows.Count, 27).End(xlUp).Row
RngC = Sh2.Range("AA2:AB" & R)
R = 1
For x = 1 To UBound(RngD)
d = RngD(x, 2)
If d <> "" Then
R = R + 1
Sh1.Cells(R, 1) = d
For y = x To UBound(RngD)
For z = 1 To UBound(RngC)
If RngD(y, 1) = RngC(z, 1) Then c = RngC(z, 2): Exit For
Next z
Sh1.Cells(R, c) = RngD(y, 3)
If y + 1 > UBound(RngD) Then x = y: Exit For
If RngD(y + 1, 2) <> "" Then x = y: Exit For
Next y
End If
Next x
End Sub fai copia incolla.
Ciao By Sal
se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui |
| | Post: 47 | Registrato il: 30/06/2016
| Città: MILANO | Età: 48 | Utente Junior | 2013 | | OFFLINE | |
|
| 22/03/2018 16:31 | |
Grazie Mille!!
ma che bravo, ho imparato un'altra cosa.
grazie
Claudio |
|
|
|
|