Allinea Dati

Hai un problema con Excel?

Nuova discussione

Allinea Dati
di Giuseppe (utente non iscritto) data: 19/07/2013 17:47:45
Ciao a tutti. Ho un problema. Devo allineare due set di dati (Colonna A e colonna C se uguali) e non so qual'è la macro da utilizzare. In pratica ho:
Colonna A-------Colonna B--------Colonna C-------Colonna D
ENST001---------2,5----------ENST005---------Antonio
ENST003---------1,5----------ENST002---------Marco
ENST005---------3------------ENST001--------Giovanni
ENST009-------6-------------ENST003---------Filippo
e devo ottenere
Colonna A-------Colonna B--------Colonna C-------Colonna D
ENST001---------2,5----------ENST001--------Giovanni
ENST003---------1,5----------ENST003---------Filippo
ENST005---------3------------ENST005---------Antonio
ENST009---------6-------------Vuoto---------Vuoto
Vuoto---------Vuoto-----------ENST002---------Marco

Qualcuno sa come aiutarmi?

Grazie anticipatamente

Giuseppe
di HarryBosch data: 19/07/2013 21:17:02
Queste richieste mi incuriosiscono sempre... è proprio vero, non ci saranno mai così tante funzioni da soddisfare tutte le esigenze ^_^
Mi sembra di aver capito, fammi pensare ad un codicillo (come dice Totygno... ^_^)

Nel frattempo hai fatto qualche tentativo? perché non è che le macro si trovino da qualche parte :)
--> "non so qual'è la macro da utilizzare"
di Giuseppe (utente non iscritto) data: 19/07/2013 23:03:39
Caro Harry Bosch,
purtroppo non capisco niente di programmazione. Di solito trovo delle macro relative a problemi postati da altri sui forum e cerco, quando possibile, di adattarla al mio quesito. In questo caso ho provato ad utilizzare una macro che, in passato, mi è andata bene per un problema analogo. Sfortunatamente non ha funzionato (non ho capito perchè ma magari tu potrai aiutarmi a capirlo). La macro che ho utilizzato (senza successo) è stata:

Sub Allinea()
Set Ws1 = Worksheets("Foglio1")
Set Ws2 = Worksheets("Foglio2")
Ws2.Columns("A:D").Clear
UR1 = Ws1.Range("A" & Rows.Count).End(xlUp).Row
Ws1.Range(Cells(1, 1), Cells(UR1, 2)).Copy Destination:=Ws2.Range("A1")
Ws1.Range(Cells(1, 3), Ws1.Cells(1, 4)).Copy Destination:=Ws2.Range("C1")
For RR1 = 2 To UR1
CodB = Ws1.Range("A" & RR1).Value
For RR2 = 2 To UR1
If Ws1.Range("C" & RR2).Value = CodB Then Ws1.Range(Cells(RR2, 3), Cells(RR2, 4)).Copy Destination:=Ws2.Range("C" & RR1)
Next RR2
Next RR1
End Sub

Ti ringrazio enormemente per la tua disponibilità.

Giuseppe

di paolomath data: 19/07/2013 23:24:33
Ciao Giuseppe, guarda un po' se può andare.

Ho utilizzato le colonne E, F, G e H come appoggio per i dati, okkio che siano libere

Sub Allinea()

Dim Righe, Trovato, k As Integer

Righe = Range("A:A").End(xlDown).Row

For i = 1 To Righe
    Trovato = 0
    For j = 1 To Righe
    If Cells(i, 1) = Cells(j, 3) Then
    Cells(i, 5) = Cells(i, 1)
    Cells(i, 6) = Cells(i, 2)
    Cells(i, 7) = Cells(j, 3)
    Cells(i, 8) = Cells(i, 4)
    Trovato = 1
    End If
    Next
    If Trovato = 0 Then
    Cells(i, 5) = Cells(i, 1)
    Cells(i, 6) = Cells(i, 2)
    Cells(i, 7) = ""
    Cells(i, 8) = ""
    End If
Next

k = 1
For i = 1 To Righe
    Trovato = 0
    For j = 1 To Righe
    If Cells(i, 3) = Cells(j, 1) Then Trovato = 1
    Next
    If Trovato = 0 Then
    Cells(Righe + k, 5) = ""
    Cells(Righe + k, 6) = ""
    Cells(Righe + k, 7) = Cells(i, 3)
    Cells(Righe + k, 8) = Cells(i, 4)
    k = k + 1
    End If
Next

Columns("E:H").Select
Selection.Copy
Columns("A:D").Select
ActiveSheet.Paste
Columns("E:H").ClearContents
Range("A1").Select

End Sub

di HarryBosch data: 20/07/2013 00:32:32
Ciao Ragazzi
ecco il "codicillo" che avevo promesso...

Quello che fa è:
- copiare i dati delle colonne C:D subito sotto la tabella
- cercare i valori della colonna A lungo la colonna C e affiancarli se uguali

Sub allinea_sotto()
    Dim ur As Integer, i As Integer, trova As Range
    Application.ScreenUpdating = False

    ur = Cells(Rows.Count, 3).End(xlUp).Row
    Range(Cells(2, 3), Cells(ur, 4)).Cut Cells(ur + 1, 3)

    For i = 2 To [counta(A:A)]
        Set trova = Columns(3).Find(Cells(i, 1), LookAt:=xlWhole)
        If Not trova Is Nothing Then
            Range(trova, trova.Offset(, 1)).Copy Cells(i, 3)
            Rows(trova.Row).Delete
        End If
    Next

    Application.ScreenUpdating = True
End Sub

Vuoi Approfondire?