Macro Trasponi

Hai un problema con Excel?

Nuova discussione

Macro Trasponi.
di Diego (utente non iscritto) data: 24/03/2015 09:59:48
Buongiorno a tutti, spero tanto che qualcuno possa darmi una mano.
La macro che mi servirebbe deve trasporre un determinato contenuto.
Allego il file per chiarezza, come si vede nella colonna B, c'è un nome Mario Rossi e a seguire una via e poi delle date.
Quello che vorrei e che la macro eseguisse il trasponi in una unica volta, cioè portare le innumerevo date della colonna B, accanto alla cella corrispondente denominata DATA di ogni cella corrispondente.
Siccome ho un foglio di lavoro con 60.000 righe, cercavo una macro che eseguisse il trasponi delle date corrispondenti con una macro che mi semplificasse il lavoro.
ringrazio anticipatamente.
di lepat (utente non iscritto) data: 24/03/2015 11:27:33
sarebbe utile avere anche il risultato desiderato
di Diego (utente non iscritto) data: 24/03/2015 11:58:00
Mi ero dimenticato allego nuovamente il file, contente il foglio1, foglio2
Non mi serve che vengano trasportati sul foglio2, ma devono essere trasformati come nel foglio2 sempre sul foglio1 dove ho piu' di 60.000 righe come quelle.

di Mister_x (utente non iscritto) data: 24/03/2015 16:17:09
ciao

la sub() la trovi in Foglio3

ciao

Option Explicit
Sub trasponiDate()
Dim i As Long
Dim URiga As Long, PRiga As Long
Dim verUriga As Long, verData As Long
verUriga = 0
verData = 0
Application.ScreenUpdating = False
For i = Cells(Rows.Count, 2).End(xlUp).Row To 1 Step -1
  If IsDate(Cells(i, 2)) Then
    If verUriga = 0 Then
     URiga = i
     verUriga = 1
     verData = 0
    End If
  Else
   If verData = 0 Then
    PRiga = i + 1
    Range("B" & PRiga & ":B" & URiga).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("C" & i).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
     verUriga = 0
     verData = 1
     Rows(PRiga & ":" & URiga).Select
      Selection.Delete Shift:=xlUp
    End If
  End If
Next i
Application.ScreenUpdating = True
Range("A1").Select
End Sub

di Diego (utente non iscritto) data: 25/03/2015 12:52:03
Ciao mille grazie per l'interessamento, ma si potrebbe inserire un tasto commandbutton per far eseguire la macro sul foglio di destinazione?
Attendo fiducioso.
di Diego (utente non iscritto) data: 26/03/2015 10:04:35
Il file non mi funzione esce scritto errore...potete aiutarmi
di Mister_x (utente non iscritto) data: 27/03/2015 00:19:55
ciao

la mia sub() nel tuo file va inserita nel foglio1 o il foglio dove tu davi fare tutta la sequenza
spero che il tuo foglio rispecchi quello che tu hai postato altrimenti non funziona un bel tubo
per il bottone o quello che vuoi basta che dal menu principale di excel attivi
Sviluppo
dove ci sono controlli vai su inserisci ti si attiva una maschera con controlli
da controlli moduli scegli il primo in alto a sinistra e disegnalo nel foglio,
automaticamente ti dira' di associare una sub() o macro clicca su quella che ti propone
fai invio e dai un nome a questi
PS il file dopo lo devi salvare con nome , con attivazione macro xlsm

ciao
di Diego (utente non iscritto) data: 28/03/2015 22:47:58
Mister_x sei stato utilissimo, ho risolto quel problemino dipendeva dal formato a ciu lo applicavo tutto ok.
Ma ho un altro problema, spero tanto che mi riesca a risolvere con la tua immensa esperienza anche questo, vengo al punto.
Nel nuovo file che ho allegato, ci sono due fogli di lavoro foglio1, foglio2.
Nel foglio1 ce un elenco, dove nella colonna B ci sono delle righe scritte.
Nel foglio2 avrei bisogno che i dati riportati nel foglio1 vengano riportati in certo modo sul foglio2.
Mi spiego, sul foglio2 nella colonna C sono riportati dei codici "4010250017", questo codice deve essere ricercato sul foglio1 e quando lo trova deve copiarmi le date corrispondenti nella colonna G al rigo che corrisponde quel codice.
Il problema e che sul foglio1 quel codice è insieme ad altre scritte "FAGggIOANO LUCA (4010250017)".
Inoltre nella colonna F una volta estrapolate e copiate le data mi dovrebbe contare il n. di date presenti esempio 27.
Questo deve avvenire per tutti quei codici presenti sul foglio2, siccome sono moltissimi speravo che mi potessi aiutare con una delle tue macro.
di Diego (utente non iscritto) data: 29/03/2015 10:51:18
Il file è Prova 2010.
Grazie.
di Diego (utente non iscritto) data: 30/03/2015 21:50:47
Nessuna anima pia che riesce a darmi una mano?

grazie
di Mister_x (utente non iscritto) data: 31/03/2015 00:31:06
ciao

allegato file con sub() inserita .xlsm

ciao
di Diego (utente non iscritto) data: 02/04/2015 12:10:11
La macro va benissimo mille grazie,
solo che riscontro un piccolo problema, il foglio1 ha 25000 righe di riferimento da copiare sul foglio2, tramite la tua macro arrivati ad una certa riga per esempio 100 va in debug si blocca e non fa piu' nulla.
forse e per la grande quantità di dati da copiare sul foglio2?
Riesci a risolvermi questo problemino nella tua strepitosa macro.
Attendo fiducioso certo della tua sopienza in vba.
Grazie mille.

di Mister_x (utente non iscritto) data: 02/04/2015 14:27:15
ciao

bisogna capire dove fa questo errore, ma avendo pchi dati a disposizione non si puo' valutare
comunque prova a sostituire la sub() di prima con questa e vedere cosa succede altrimenti mi devi passare il file completo senza dati sensibili ma con le sole date e e il corrispettivo di ricerca

ciao

Option Explicit
Sub RifCodice()
Sheets("foglio2").Select
Dim i As Long, o As Long
Dim Codice2 As String
Dim Codice1 As String
Application.ScreenUpdating = False
Application.EnableEvents = False
Range("F6:AZ1000") = ""
For i = 6 To Cells(Rows.Count, 3).End(xlUp).Row
Codice2 = Cells(i, 3)
 For o = 1 To Sheets("foglio1").Cells(Rows.Count, 2).End(xlUp).Row
  Codice1 = Sheets("foglio1").Cells(o, 2)
  If InStr(1, Codice1, "(") > 0 Then
    If Codice2 = Mid(Codice1, InStr(1, Codice1, "(") + 1, 10) Then
      Sheets("foglio1").Range("C" & o + 2 & ":AZ" & o + 2).Copy
      Cells(i, 7).Select
      ActiveSheet.Paste
      Cells(i, 6) = Application.CountA(Range("G" & i & ":AZ" & i))
      Application.CutCopyMode = False
    End If
   End If
 Next o
Next i
Range("H5").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

di Diego (utente non iscritto) data: 02/04/2015 15:51:49
Sul tuo file allegato con la prima macro accade questo, se provo a copiare dal file originale i dati del foglio1 200 righe alla volta, cioè 200 righe e applico la macro mi incolla tutto giusto, se aggiungo altre 200 righe alle precedenti ed applico la macro copia tutto in modo giusto.
Siccome sono 25000 righe copiare una certa quantità per volta per scavalcare l'errore, non finisco piu'.
Credo che sia un errore che genera a causa della quantità consecutiva di righe che deve leggere 25000, perchè se copio un po di righe alla volta esegue la macro perfettamente, l'errore viene causato solo quando deve eseguire la macro su 25000.
Pensi di riuscire a risolvermi il problema, con la seconda macro che hai messo non copia neanche quelle vecchie.
La prima è perfetta unica pecca e la quantità di righe che elabora la macro.
Ti ringrazio intanto per l'enorme pazienza che hai ed il tempo che ci dedichi.
grazie Mille
di Diego (utente non iscritto) data: 03/04/2015 08:54:24
Buongiorno, stavo pensando per semplificare le cose, siccome i due fogli di lavoro sono quasi simili, si potrebbe modificare la prima macro del trasponi, nella mia richiesta si faceva il trasponi delle date accanto alla cella con scritto "Data"; si potrebbe modificare quella macro spostando in una sola riga accanto alla cella che contiene esempio:"MARIO RooOSSI (4010060028)" la via, Data, ed tutte le date.
Quindi in cella B6 "MARIO RooOSSI (4010060028)"
in cella C6 " viale "
in cella D6 "Data"
in cella E6 " tutte le date"
Forse è la soluzione piu' veloce, era solo una idea.
Ho provato ma sbaglio nei riferimenti.
Grazie ancora aspetto tue notizie sia in un senso che nell'altro, non so quale ti viene meglio.
Ciao Diego
di Mister_x (utente non iscritto) data: 03/04/2015 13:13:46
ciao diego

quindi tu dici di provare a tenere tutti i dati sul foglio1 mettendo questi non piu su 4 righe ma su una riga sola
si potrebbe provare anche questa via,
se e questo che intendi fallo sapere , che appena ho 2 minuti vedo di creare questa sub()
PS le rigneche dopo rimangono bianche le lasciamo o le annulliamo??

ciao
di Diego (utente non iscritto) data: 03/04/2015 21:00:19
Se si potrebbero togliere le righe bianche che ci sono durante il trasponi sarebbe ottimo.
Praticamente verrebbe come il foglio2 se ci fai caso.
Mi servirebbero tutti su una riga quindi nome, via, data, ecc....
tutto senza righe vuote una sotto l'atra.
Sempre che te riesca a farcela, ma immagino di si vedendo le mega macro che sai fare.
Sei veramente bravo.
Ancora grazie, e in anticipo auguroni di buona Pasqua

di Mister_x (utente non iscritto) data: 04/04/2015 00:16:28
ciao

da mettere nel foglio e provare

ciao

Option Explicit
Sub CopiaRighe()
Dim i As Long
For i = Cells(Rows.Count, 2).End(xlUp).Row To 4 Step -1
 If Cells(i, 2).Value = "Data" Then
   Range(Cells(i, 2), Cells(i, 45)).Select
   Selection.Cut
   Cells(i - 2, 4).Select
   ActiveSheet.Paste
       '''''''
   Cells(i - 1, 2).Select
   Selection.Cut
   Cells(i - 2, 3).Select
   ActiveSheet.Paste
 End If
 If Cells(i, 2) = "" Then Rows(i & ":" & i).Delete Shift:=xlUp
Next i
End Sub

di Diego (utente non iscritto) data: 11/04/2015 21:55:13
Ciao scusami se non ti ho risposto prima, ma sono stato via.
Ho provato la macro che mi hai scitto, ma traspone tutto perfettamente ma senza le date.
cioè nome, via, data, ma l'lelenco delle date le lascia sempre in colonna.
Sai dirmi cosa posso fare?
Mille grazie
di Mister_x (utente non iscritto) data: 13/04/2015 17:43:59
ciao diego

potresti postare il file che non riesci a completare, in quanto come vedi dopo 3 o 4 giorni questi vengono tolti, se non aggiornati, quindi non avendo salvato niente sul mio pc non sarei in grado di aiutarti, lo stesso dicasi per gli altri utenti che ti vogliono rispondere

ciao
di Diego (utente non iscritto) data: 14/04/2015 09:48:52
Il file che ti ho allegatio è quello che devo modificare, dove devono essere spostate su di una solo riga tutti riferimenti come ti dicevo.
grazie

di Mister_x (utente non iscritto) data: 14/04/2015 15:22:09
ciao diego

bastava utilizzare tutte e due le sub() assieme e modificare un dato alla seconda e il lavoro viene fatto
vedi file allegato con la sub() inserita in foglio1
in questo caso il foglio lo ritrovi come l'originale, attiva il bottone e ti troverai il foglio modificato

ciao

Option Explicit
Sub trasponiDate()
Dim i As Long
Dim URiga As Long, PRiga As Long
Dim verUriga As Long, verData As Long
verUriga = 0
verData = 0
Application.ScreenUpdating = False
For i = Cells(Rows.Count, 2).End(xlUp).Row To 1 Step -1
  If IsDate(Cells(i, 2)) Then
    If verUriga = 0 Then
     URiga = i
     verUriga = 1
     verData = 0
    End If
  Else
   If verData = 0 Then
    PRiga = i + 1
    Range("B" & PRiga & ":B" & URiga).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("C" & i).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
     verUriga = 0
     verData = 1
     Rows(PRiga & ":" & URiga).Select
      Selection.Delete Shift:=xlUp
    End If
  End If
Next i
Call CopiaRighe '' inserito richiamo alla sub CopiaRighe
Application.ScreenUpdating = True
Range("A1").Select
End Sub


Sub CopiaRighe()
Dim i As Long
For i = Cells(Rows.Count, 2).End(xlUp).Row To 4 Step -1
 If Cells(i, 2).Value = "Data" Then
   Range(Cells(i, 2), Cells(i, 45)).Select
   Selection.Cut
   Cells(i - 2, 6).Select ''cambiato valore colonna
   ActiveSheet.Paste
       '''''''
   Cells(i - 1, 2).Select
   Selection.Cut
   Cells(i - 2, 4).Select ''cambiato valore colonna
   ActiveSheet.Paste
 End If
 If Cells(i, 2) = "" Then Rows(i & ":" & i).Delete Shift:=xlUp
Next i
End Sub

Vuoi Approfondire?