Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

mettere in colonna tutte le righe in base al valore di A

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

mettere in colonna tutte le righe in base al valore di A

Postdi c_ros » 22/03/14 20:24

Ciao a tutti!!!Eccomi di nuovo qui a chiedervi aiuto...:) (prima o poi imparerò a programmare in VBA. ;)
Ho una tabella con 4809 righe e vorrei che tutti valori presenti nelle righe da B a AE vengano messi in colonna a lato del rispettivo valore presente in A e quindi per ogni elemento A ripetere tale elemento tante volte quante sono gli elementi delle righe...Lo so è un pò contorta la cosa...l'esempio è questo:

L0 263A 1048T 3516a 5442C 6185C 9042T 9347G 10589A 12007A 12720G
L0a'b'f'k 189G 4586C 9818T 16172C
L0a'b'f 73A 185A 195T 2245G 5603T 11641G 15136T 15431A

e vorrei ottenere questo:

L0 263A
L0 1048T
L0 3516a
L0 5442C
L0 6185C
L0 9042T
L0 9347G
L0 10589A
L0 12007A
L0 12720G
L0a'b'f'k 189G
L0a'b'f'k 4586C
L0a'b'f'k 9818T
L0a'b'f'k 16172C
L0a'b'f 73A
L0a'b'f 185A
L0a'b'f 195T
L0a'b'f 2245G
L0a'b'f 5603T
L0a'b'f 11641G
L0a'b'f 15136T
L0a'b'f 15431A
vi allego il file di partenza e la bozza del file che vorrei ottenere, ecco i link:
http://rapidshare.com/share/BD2402760EB ... 082F88F735
http://rapidshare.com/share/D9C6F10FDA0 ... 00FAE67600

Grazie in anticipo a tutti!!!
c_ros
Utente Junior
 
Post: 24
Iscritto il: 06/01/14 19:39

Sponsor
 

Re: mettere in colonna tutte le righe in base al valore di A

Postdi ricky53 » 22/03/14 22:06

Ciao,
prova con questo esempio che va copiato in un "Modulo" ed eseguito con "F5".

Prima di eseguire la macro fai una copia del tuo file!!!


Nella macro ho supposto che i dati da copiare fossero sul "Foglio1", che partissero dalla prima riga e dalla colonna "A".
Eseguendo la macro la copia dei dati verrà fatta sul "Foglio2"

Codice: Seleziona tutto
Option Explicit

Sub Copia_e_Trasponi()
    Dim I As Long, J As Long, UR As Long, CC As Integer, RR As Integer, WS_In As Worksheet, WS_Out As Worksheet
    Dim Inizio As Double
   
    Application.ScreenUpdating = False
    Inizio = Timer
    Set WS_In = Sheets("Foglio1")
    Set WS_Out = Sheets("Foglio2")
   
    UR = WS_In.Range("A" & Rows.Count).End(xlUp).Row
   
    WS_Out.Select
    For I = 1 To UR
        J = WS_Out.Range("A" & Rows.Count).End(xlUp).Row + 1
        CC = WS_In.Range("B" & I).End(xlToRight).Column
        WS_In.Range(WS_In.Cells(I, "B"), WS_In.Cells(I, CC)).Copy
        WS_Out.Cells(J, "B").Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        RR = WS_Out.Range("B" & Rows.Count).End(xlUp).Row
        WS_In.Cells(I, "A").Copy Destination:=WS_Out.Cells(J, "A")
        WS_Out.Cells(J, "A").Copy
        WS_Out.Range(WS_Out.Cells(J + 1, "A"), WS_Out.Cells(RR, "A")).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
    Next I
    Set WS_In = Nothing
    Set WS_Out = Nothing
    Application.ScreenUpdating = True

    MsgBox "E' stata effettuata la copia dei dati in:  '" & Format(Timer - Inizio, "0.000") & "'   sec."
End Sub



Prova e ... sono QUI
Dice il vecchio saggio provare e riprovare è l'unica strada per imparare

Più chiara è la vostra spiegazione
Più immediata sarà la nostra soluzione


. . . . . . . . . .
S.O. W7; Office 2003-10-13-16
Avatar utente
ricky53
Utente Senior
 
Post: 4223
Iscritto il: 11/04/09 19:29
Località: Italia

Re: mettere in colonna tutte le righe in base al valore di A

Postdi c_ros » 22/03/14 22:52

Grazie grazie grazie!!!funziona benissimo!!!:) :)
c_ros
Utente Junior
 
Post: 24
Iscritto il: 06/01/14 19:39

Re: mettere in colonna tutte le righe in base al valore di A

Postdi PcBase » 22/03/14 23:17

Ciao
Provate con:
Nota: Il numero dei valori estratti non corrisponde con il codice precedente

Codice: Seleziona tutto
Option Explicit

Sub Forum_Test()

    Dim varData()               As Variant
    Dim varFinalData()          As Variant
    Dim lngTotalDataCell        As Long
    Dim lngLoop                 As Long
    Dim lngLoop1                As Long
    Dim lngCount                As Long
    Dim Txt                     As String
    Const strDataRange          As String = "A1:AE4578"
    Const strDataShtName        As String = "Foglio1"
    Const DestinationShtName    As String = "Foglio2"
    Const strOutDataCell        As String = "A1"
   
    With ThisWorkbook.Worksheets(strDataShtName)
        varData = .Range(strDataRange).Value
        lngTotalDataCell = WorksheetFunction.CountA(.Range(strDataRange))
        ReDim varFinalData(1 To lngTotalDataCell, 1 To 2)
        lngCount = 0
        For lngLoop = LBound(varData) To UBound(varData)
            Txt = varData(lngLoop, LBound(varData))
            For lngLoop1 = LBound(varData) + 1 To UBound(varData, 2)
              If lngLoop1 > 2 Then
                If LenB(Trim(varData(lngLoop, lngLoop1))) Then
                    lngCount = lngCount + 1
                    varFinalData(lngCount, 1) = Txt
                    varFinalData(lngCount, 2) = varData(lngLoop, lngLoop1)
                End If
              Else
                lngCount = lngCount + 1
                varFinalData(lngCount, 1) = Txt
                varFinalData(lngCount, 2) = varData(lngLoop, lngLoop1)
              End If
            Next lngLoop1
        Next lngLoop
    End With
    Worksheets(DestinationShtName).Range("A1").Resize(UBound(varFinalData), UBound(varFinalData, 2)).Value = varFinalData
    Erase varData
    Erase varFinalData
    lngTotalDataCell = Empty
    lngLoop = Empty
    lngLoop1 = Empty
    lngCount = Empty

End Sub
Windows xp + Office 2003 Ita
Windows8 Office 2013
PcBase
Utente Senior
 
Post: 129
Iscritto il: 24/02/11 23:26

Re: mettere in colonna tutte le righe in base al valore di A

Postdi ricky53 » 23/03/14 12:22

Ciao,
vero PCBase non sapevo di alcune condizioni sui codici che potevano esistere senza dati nella colonna "B".

Ecco il codice modificato
Codice: Seleziona tutto
Option Explicit

Sub Copia_e_Trasponi()
    Dim I As Long, J As Long, UR As Long, CC As Integer, RR As Integer, WS_In As Worksheet, WS_Out As Worksheet
    Dim Inizio As Double
   
    Application.ScreenUpdating = False
    Inizio = Timer
    Set WS_In = Sheets("Foglio1")
    Set WS_Out = Sheets("Foglio2")
   
    UR = WS_In.Range("A" & Rows.Count).End(xlUp).Row
   
    WS_Out.Select
    For I = 1 To UR
        J = WS_Out.Range("A" & Rows.Count).End(xlUp).Row + 1
        CC = WS_In.Cells(I, Columns.Count).End(xlToLeft).Column ' <<<===== Modificata
' Aggiunte
        If CC > 1 Then
            WS_In.Range(WS_In.Cells(I, "B"), WS_In.Cells(I, CC)).Copy
            WS_Out.Cells(J, "B").Select
            Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=True
        End If
' Aggiunte
        RR = WS_Out.Range("B" & Rows.Count).End(xlUp).Row
        WS_In.Cells(I, "A").Copy Destination:=WS_Out.Cells(J, "A")
        If CC > 2 Then ' <<<====== Aggiunta
            WS_Out.Cells(J, "A").Copy
            WS_Out.Range(WS_Out.Cells(J + 1, "A"), WS_Out.Cells(RR, "A")).Select ' Funzionante !!!
            ActiveSheet.Paste
        End If
        Application.CutCopyMode = False
    Next I
    Set WS_In = Nothing
    Set WS_Out = Nothing
    Application.ScreenUpdating = True

    MsgBox "E' stata effettuata la copia dei dati in:  '" & Format(Timer - Inizio, "0.000") & "'   sec."
End Sub


Andrebbe ottimizzato per velocizzarlo introducendo l'utilizzo delle ARRAY, se l'utilizzo non è molto frequente si possono aspettare i circa "10" secondi per avere l'elaborazione dei dati.
Dice il vecchio saggio provare e riprovare è l'unica strada per imparare

Più chiara è la vostra spiegazione
Più immediata sarà la nostra soluzione


. . . . . . . . . .
S.O. W7; Office 2003-10-13-16
Avatar utente
ricky53
Utente Senior
 
Post: 4223
Iscritto il: 11/04/09 19:29
Località: Italia

Re: mettere in colonna tutte le righe in base al valore di A

Postdi Anthony47 » 23/03/14 22:45

Se la velocita' e' un problema si puo' provare questa versione di macro, dovrebbe essere abbastanza piu' rapida:
Codice: Seleziona tutto
Sub roscli()
Dim LBd2 As Long, myData As String, myOutput As String, myTim As Single, UBd2 As Long
Dim CCount As Long, RCount As Long, VArr, RArr(1 To 100000, 1 To 2)
Dim I As Long, CRC As Long, J As Long, NextR As Long
'
myData = "Foglio1"      '<< Foglio con i dati di origine
myOutput = "Foglio2"    '<< Foglio in cui si crea l' output desiderato
'
Sheets(myData).Select
myTim = Timer
Sheets(myOutput).Range("A:C").ClearContents      ' VEDI TESTO
CCount = ActiveSheet.UsedRange.Columns.Count - 1
RCount = Cells(Rows.Count, 1).End(xlUp).Row
'
VArr = Range("A1").Resize(RCount, CCount + 1).Value
UBd2 = UBound(VArr, 2)
LBd2 = LBound(VArr, 2) + 1
'
For I = LBound(VArr, 1) To UBound(VArr, 1)
    CRC = 0
    'C_R_Counter:
    For J = LBound(VArr, 2) + 1 To UBd2
        If VArr(I, J) <> "" Then
            CRC = CRC + 1
        Else
            Exit For
        End If
    Next J
'
'
'distribuisci in RArr
    If NextR < 2 Then NextR = 2
    If CRC > 0 Then
        For J = LBd2 To LBd2 + CRC - 1
            RArr(NextR + J - LBd2, 1) = VArr(I, 1)
            If VArr(I, J) <> "" Then
                RArr(NextR + J - LBd2, 2) = VArr(I, J)
            Else
                Exit For
            End If
        Next J
    DoEvents
    Else
        RArr(NextR, 1) = VArr(I, 1)
    End If
'Aggiorna NextR:
    If CRC > 0 Then NextR = NextR + CRC Else NextR = NextR + 1
    DoEvents
Next I
'dump RArr:
Sheets(myOutput).Range("A1").Resize(NextR, 2).Value = RArr
Sheets(myOutput).Range("A1:B1").Value = Array("Lista1", "Lista2")  '<< Le intestazioni
MsgBox ("Completato in ... " & (Timer - myTim))
End Sub

Le istruzioni marcate << vanno personalizzate; si tenga presente che le colonne A:C del foglio di output saranno RIPULITE SENZA PREAVVISO a inizio macro.

Il codice suggerito gestisce max 100mila righe di output.

Ciao a tutti.
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13892
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: mettere in colonna tutte le righe in base al valore di A

Postdi PcBase » 23/03/14 23:03

In merito a:
Il codice suggerito gestisce max 100mila righe di output.


Anthony Nel codice che ho proposto in precedenza si può utilizzare..
Codice: Seleziona tutto
lngTotalDataCell = WorksheetFunction.CountA(.Range(strDataRange))
        ReDim varFinalData(1 To lngTotalDataCell, 1 To 2)

E otteniamo la necessaria dimensione
Windows xp + Office 2003 Ita
Windows8 Office 2013
PcBase
Utente Senior
 
Post: 129
Iscritto il: 24/02/11 23:26

Re: mettere in colonna tutte le righe in base al valore di A

Postdi Anthony47 » 23/03/14 23:23

E' vero, in quel modo si evita il dimensionamento a caso di RArr() su 100mila righe, anche se non si ottiene i dimensionamento preciso...
Nel mio codice va modificata la Dim iniziale di RArr e inserita la Redim; che corrisponde a queste variazioni:
Codice: Seleziona tutto
Sub roscli()
Dim LBd2 As Long, myData As String, myOutput As String, myTim As Single, UBd2 As Long
Dim CCount As Long, RCount As Long, VArr, RArr()      'MODIFICATA
Dim I As Long, CRC As Long, J As Long, NextR As Long
'
myData = "Foglio1"      '<< Foglio con i dati di origine
myOutput = "Foglio2"    '<< Foglio in cui si crea l' output desiderato
'
Sheets(myData).Select
myTim = Timer
Sheets(myOutput).Range("A:C").ClearContents
CCount = ActiveSheet.UsedRange.Columns.Count - 1
RCount = Cells(Rows.Count, 1).End(xlUp).Row
ReDim RArr(1 To Application.WorksheetFunction.CountA(ActiveSheet.UsedRange), 1 To 2)    'AGGIUNTA
'
VArr = Range("A1").Resize(RCount, CCount + 1).Value
'etc etc

Vedi una riga MODIFICATA e una riga AGGIUNTA.

Ciao a tutti
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13892
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: mettere in colonna tutte le righe in base al valore di A

Postdi c_ros » 28/03/14 18:19

Siete gentilissimi!!!!grazie a tutti!!!:)
c_ros
Utente Junior
 
Post: 24
Iscritto il: 06/01/14 19:39


Torna a Applicazioni Office Windows


Topic correlati a "mettere in colonna tutte le righe in base al valore di A":


Chi c’è in linea

Visitano il forum: Nessuno e 7 ospiti