Separatori

Hai un problema con Excel?

Nuova discussione

Separatori
di Jellyfish data: 17/10/2012 15:37:21
Ciao a tutti,

ecco una nuova domanda con foglio di esempio.

Ho una tabella nel foglio uno e la voglio trasformare automaticamente con una macro nella tabella del foglio 2

Se ho un solo nome di ragazza il campo "Ragazza" inizia sempre con ";" in caso possa essere utile.

Non so nemmeno da dove iniziare. Qualche idea?
di canapone (utente non iscritto) data: 17/10/2012 16:00:26

Ciao,

se il file sul quale lavori ha la struttura che hai allegato come esempio, si può ottenere velocemente l'elenco anche usando una pivot in una maniera creativa.

Una macro è una soluzione migliore, ma sono a digiuno di Vba.

Saluti

di HarryBosch data: 17/10/2012 17:21:09
Si potrebbe risolvere con lo "Split"
una cosa come sotto

Vedi se fa esattamente quello che intendi

Sub copia_e_moltiplica()
Dim elenco As Range, nome As Range
Dim n As Variant
Dim i As Integer

Application.ScreenUpdating = False

Sheets("Sheet1").[a1].CurrentRegion.Copy _
  Destination:=Sheets("Sheet2").[a1]

Sheets("Sheet2").Activate
    Set elenco = Range("b1:b5")
    For Each nome In elenco
        n = Split(nome, ";")

        If UBound(n) = 1 Then
            nome.Value = n(1)

        ElseIf UBound(n) > 1 Then
            nome.Value = n(0)
            For i = 1 To UBound(n)
                nome.Offset(i, 0).EntireRow.Insert
                nome.Offset(i, 0).Value = n(i)
                nome.Offset(i, -1).Value = nome.Offset(0, -1)
            Next i
        End If

    Next
Application.ScreenUpdating = True
End Sub

di HarryBosch data: 17/10/2012 17:24:28
Mi son dimenticato di correggere il range:
Set elenco = Range("b1:b5")

così prende solo le prime cinque righe... ma confido che in questo punto riesci a sistemare in base alla tua esigenza.
di Jellyfish data: 17/10/2012 17:58:16
Grazie mille!

Questo codice lo riesco a leggere :)

Questa sera o domani provo tutto e ti faccio sapere!

Grazie ancora!

Giorgia
di Vecchio Frac data: 17/10/2012 20:41:55
Il codice funziona benissimo.

cit. "Sub copia_e_moltiplica()"
--> Vanni, ROTFL mi fai morire coi nomi che dai alle Sub :D
di HarryBosch data: 18/10/2012 01:41:55
@VecchioFrac
A volte mi rotolo anch'io da solo!
Soprattutto a quest'ore
di Jellyfish data: 18/10/2012 14:29:12
Ciao Harry,

cosa significa "Application.ScreenUpdating"?
di Vecchio Frac data: 18/10/2012 14:34:25
In attesa della risposta di Vanni, prova ad evidenziare la parola ScreenUpdating e premi F1.
Si apre la Guida che a volte è esauriente e può aiutarti almeno a capire cosa fanno istruzioni sconosciute, oltre a contenere anche dei rimandi tipo "Si applica a" oppure degli "Esempi".
Questo suggerimento, vedrai, ti risulterà utilissimo tutte le volte che vorrai avere un rinfresco rapido della memoria sull'uso o la sintassi delle istruzioni.
Forse hai Excel non in italiano, e la Guida quindi non è in italiano, spero che ciò non sia un problema.
di Jellyfish data: 18/10/2012 14:52:02
Funziona!!!

Però il DB non è formato solo da due coloenne ma da 60 con un sacco di righe...

Il campo "Nome" è alla colonna I quindi ho messo Set elenco = Range("I1:I10000") e mi dovrebbero bastare.

Ora mi iserisce le righe e mette il nuovo nome e mi copia l'interesse. Prima dell'interesse ho altre 7 colonne e dopo il campo"Nome" ne ho altre 41.

COme faccio a fargli copiare anche gli altri dati :( ho provato a modificare gli offsett ma mi incasina e basta :(
di Vecchio Frac data: 18/10/2012 15:40:55
Il nocciolo è qui:
nome.Offset(i, -1).Value = nome.Offset(0, -1)

bisogna ripetere questa istruzione per tutte le celle da duplicare a sinistra e per tutte le celle da duplicare a destra
Quindi premesso che:
- riga è la riga dove si trova ad ogni ciclo il "nome" attuale (perchè abbiamo deciso di ciclare "For Each nome In elenco")
- colonna è parimenti la colonna attuale del "nome" ad ogni ciclo,

serve una sequenza che ricopi in basso i dati:
da cella (riga, colonna 1 del foglio) a cella (riga, colonna del nome - 1)
e
da cella (riga, colonna del nome + 2) a cella (riga, colonna finale della tabella)

Vero?

di Jellyfish data: 18/10/2012 15:47:24
Non so bene cosa faccia ma ho torvato il modo di fargli inserire l'inera riga :)

Ho aggiunto "Processo.Offset(i, 0).EntireRow.Copy"

Sotto il codice finale.

Grazie ancora Harry

Sub copia_e_moltiplica()
Dim elenco As Range, Processo As Range
Dim n As Variant
Dim i As Integer



Sheets("Sheet2").Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select

Application.ScreenUpdating = False

Sheets("Sheet1").[a1].CurrentRegion.Copy _
  Destination:=Sheets("Sheet2").[a1]

Sheets("Sheet2").Activate
    Set elenco = Range("I1:I10000")
    For Each Processo In elenco
        n = Split(Processo, ";")

        If UBound(n) = 1 Then
            Processo.Value = n(1)

        ElseIf UBound(n) > 1 Then
            Processo.Value = n(0)
            For i = 1 To UBound(n)
                Processo.Offset(i, 0).EntireRow.Copy
                Processo.Offset(i, 0).EntireRow.Insert
                Processo.Offset(i, 0).Value = n(i)
                Processo.Offset(i, -1).Value = Processo.Offset(0, -1)
            Next i
        End If

    Next
Application.ScreenUpdating = True
End Sub

di Vecchio Frac data: 18/10/2012 15:51:15
cit. " Non so bene cosa faccia "
--> ROTFL ^_^

cit. " Grazie ancora Harry "
--> Harry è sempre nei nostri pensieri naturalmente ^_^

di HarryBosch data: 18/10/2012 16:07:53
Very gooooood!! Brava!
Ti stavo ripostando il codice corretto con quella piccolissima riga che hai già aggiunto.
Visto che ci sono lo metto lo stesso; troverai altre due aggiunte che possono tornarti utili anche in altre circostanze:
- la "pulizia" completa del foglio, prima di scrivere i dati:
Cells.ClearContents
- e la determinazione dell'ultima cella occupata di un intervallo:
tot = [counta(i:i)]
Set elenco = Range("i1:i" & tot)

--> ROTFL ^_^ : è una lunga storia...

Sub copia_e_moltiplica()
    Dim elenco As Range, nome As Range
    Dim n As Variant
    Dim i As Integer, tot As Integer
    Application.ScreenUpdating = False
    
    Sheets("Sheet2").Cells.ClearContents
    Sheets("Sheet1").[a1].CurrentRegion.Copy _
            Destination:=Sheets("Sheet2").[a1]

    Sheets("Sheet2").Activate
    tot = [counta(i:i)]
    Set elenco = Range("i1:i" & tot)
    For Each nome In elenco
        n = Split(nome, ";")

        If UBound(n) = 1 Then
            nome.Value = n(1)

        ElseIf UBound(n) > 1 Then
            nome.Value = n(0)
            For i = 1 To UBound(n)
                nome.EntireRow.Copy
                nome.Offset(i, 0).EntireRow.Insert
                nome.Offset(i, 0).Value = n(i)
                nome.Offset(i, -1).Value = nome.Offset(0, -1)
            Next i
        End If
    Next

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

di Vecchio Frac data: 18/10/2012 16:13:17
cit. " ROTFL ^_^ : è una lunga storia... "
--> Uau, un intrigo a corte!! :P
Della serie: "Non solo VBA" :)
di Jellyfish data: 18/10/2012 16:34:54
Grazie per le aggiunte perchè mi servono!!!

Intanto metto dentro questo codice!

Grazie mille!
di Jellyfish data: 18/10/2012 16:38:21
Certo non capire che fa il codice un pò mi irrita!!!

Dove si studia VBA???
di Vecchio Frac data: 18/10/2012 16:44:49
Per parte mia, non l'ho mai studiato mediante libri, ma solo attraverso l'esercizio, il tentativo, l'errore, la Guida incorporata (F1) e, da quando per me è esistita una connessione internet (dal 1993) anche mediante lo studio di codice altrui, di scambi su forum, newsgroup, ecc.
Anche il registratore di macro ha la sua brava utilità, con le limitazioni di cui soffre :)
di Jellyfish data: 28/10/2012 21:12:40
Harry!!! Nuuuuu il codice ha un problema che non riesco a risolvere :(

Se guari il file in allegato

La diga 5 si perde "Luisa"

Come mai????

di Jellyfish data: 28/10/2012 22:38:01
Ho capito!!!

Ci sono riuscita!!!

invece di:

If UBound(n) = 1 Then
nome.Value = n(1)

ho messo:
If Left(nome, 1) = ";" Then
nome.Value = n(1)

e nelle seconda condizione ho messo >= 1 invece che solo >1

Sub copia_e_moltiplica()
    Dim elenco As Range, nome As Range, primonome As Range
    Dim n As Variant
    Dim i As Integer, tot As Integer
    Application.ScreenUpdating = False
    
    Sheets("Sheet2").Cells.ClearContents
    Sheets("Sheet1").[a1].CurrentRegion.Copy _
            Destination:=Sheets("Sheet2").[a1]

    Sheets("Sheet2").Activate
    tot = [counta(a:a)]
    Set elenco = Range("I1:I" & tot)
    For Each nome In elenco
        n = Split(nome, ";")

    If Left(nome, 1) = ";" Then
        nome.Value = n(1)
    
    ElseIf UBound(n) >= 1 Then
            nome.Value = n(0)
            For i = 1 To UBound(n)
                nome.EntireRow.Copy
                nome.Offset(i, 0).EntireRow.Insert
                nome.Offset(i, 0).Value = n(i)
                nome.Offset(i, -1).Value = nome.Offset(0, -1)
            Next i
        End If

    Next
    

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

di Jellyfish data: 28/10/2012 22:56:06
Però mi mette una riga in più sopra luisa... :(
di Jellyfish data: 28/10/2012 23:27:37
No no, nessuna riga di troppo sono io che mettevo un ";" in più dove non c'è...

tuttavi ami pare che ci impieghi moooooolto pìù tempo :(

di HarryBosch data: 29/10/2012 08:08:01
Ciao Jelly
si.. non mi ero accorto di questo fatto; del resto le prove servono proprio a verificare gli eventuali accorgimenti da adottare.
Riguardando il codice ho pensato che è meglio fare un tipo diverso di controllo, non con UBound, ma verificando il primo valore assunto dallo split se la cella è diversa da vuota.
Vedi la correzione sotto, ora dovrebbe funzionare a dovere.

Comunque credo che anche la tua soluzione funzioni, semmai è da capire perchè ci impiega molto. Quanti dati hai?

Sub copia_e_moltiplica()
    Dim elenco As Range, nome As Range
    Dim n As Variant
    Dim i As Integer, tot As Integer
    Application.ScreenUpdating = False
    
    Sheets("Sheet2").Cells.ClearContents
    Sheets("Sheet1").[a1].CurrentRegion.Copy _
            Destination:=Sheets("Sheet2").[a1]

    Sheets("Sheet2").Activate
    tot = [counta(a:a)]
    Set elenco = Range("i1:i" & tot)
    For Each nome In elenco
    If nome <> "" Then
        n = Split(nome, ";")
    
        If n(0) = "" Then
            nome.Value = n(1)

        ElseIf n(0) <> "" Then
            nome.Value = n(0)
            For i = 1 To UBound(n)
                nome.EntireRow.Copy
                nome.Offset(i, 0).EntireRow.Insert
                nome.Offset(i, 0).Value = n(i)
                nome.Offset(i, -1).Value = nome.Offset(0, -1)
            Next i
        End If
        End If
    Next

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

di Jellyfish data: 29/10/2012 09:12:16
Ciao Harry,

ho tipo 3000 righe che diventano 5000 una volta fatto girare il codice.

Funzionano entrambi e impiegano entrmbi più o meno lo stesso tempo.

La modifica che ho fatto io è concettualmente sbagliata o secondo te posso lasciarla?
di HarryBosch data: 29/10/2012 11:18:18
Va benissimo anche la tua modifica; l'importante è che la "regola" sia costante, ovvero che quando ci siano più di un nome non si inizi con il punto e virgola (vale anche per il codice che ti ho messo io).

Per quanto riguarda il tempo di esecuzione credo che le differenze siano legate soltanto alla "potenza" del pc, in particolare si deve fare riferimento all'utilizzo della ram. Ho testato la macro con circa 5000 righe (portate a 8000 dopo l'inserimento delle righe) e il (mio) tempo di esecuzione è stato di circa 7/8 secondi... che ritengo abbastanza normale.
di Jellyfish data: 29/10/2012 12:30:20
A me ci mette a volte 1 minuto ma volte 5....

Cmq va bene e funziona sono felicissima!

Grazie ancora

Vuoi Approfondire?