cercare ordinare numeri

[raimea]

ciao a tutti
sto cercando di automatizzare un ordinamento numeri.
nel foglio ho 49 numeri (lotto inglese), per ogni numero ci sono 3 colonne gialla,verde,blu
che manualmente vado a compilare.
dalla cella D17 in giu', vado a scrivere un numero che corrisponde a quello scritto in riga 2
vorrei che con un pulsante dopo aver scritto il numero in della D17 vado a cercare tale numero in riga 2,
prelevi i numeri scritti nelle 3 colonne e me li scriva sulla stessa riga da cella e17:N17
naturalmente metterei un pulsante a fianco di ogni riga di colonna D18,d19 ecc...

e' possibile.... ?
la vedo difficile.

ora tale lavoro lo sto facendo manualmente scrivendo ogni volta i numeri su carta e poi li riporto nel file...

provo ad allegare il file

http://www.megaupload.com/?d=A7FHU88B

[Flash30005]

E' possibile!

Copia in un modulo l'intera macro

Codice: Seleziona tutto

Public RigaN As Integer
Sub trascrivi()
Range(Cells(RigaN, 5), Cells(RigaN, 14)).Clear
For CC1 = 5 To 145 Step 3
    If Cells(2, CC1).Value = Cells(RigaN, 4).Value Then
        For CC2 = CC1 - 1 To CC1 + 1
            URC = Cells(11, CC2).End(xlUp).Row
            If URC < 3 Then GoTo SaltaC
            For RR1 = 3 To URC
                Cells(RR1, CC2).Copy Destination:=Cells(RigaN, 15).End(xlToLeft).Offset(0, 1) ' con formattazione colore commentare se non la si vuole
                'Cells(RigaN, 15).End(xlToLeft).Offset(0, 1).Value = Cells(RR1, CC2).Value   ' solo valori togliere commento se non si vuole la formattazione a colori precedente
            Next RR1
SaltaC:
        Next CC2
        GoTo esci
    End If
Next CC1
esci:
Call Formato
End Sub

Sub Formato()
    Range("E" & RigaN & ":N" & RigaN).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlDouble
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .Weight = xlThick
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End Sub


E nel VBA foglio il seguente codice

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
UR = Range("D" & Rows.Count).End(xlUp).Row
If UR < 17 Then UR = 17
CheckArea = "D17:D" & UR
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then Exit Sub
If Target <> "" Then
RigaN = Target.Row
Call trascrivi
End If
End If
End Sub


Ciao

[raimea]

mamma mia va come un treno
ottimo il riportare anche il formato/ colore....

unico piccolo inconvegnente non mi riporta i valori degli ultimi 2 numeri il 48 e il 49
poi fa cio' che volevo
PS
avevo quasi "vergogna" a chiedere aiuto perche' mi sembra un po0 troppo chiedere tale funzione...

[Flash30005]

Devi cambiare il valore del For... next da 145 a 149 come indicato

Codice: Seleziona tutto

Sub trascrivi()  '<<<nome macro
Range(Cells(RigaN, 5), Cells(RigaN, 14)).Clear '<<< riga esistente
For CC1 = 5 To 149 Step 3  '<<<< mettere 149 qui
'... resto della macro


Poi visto che ci siamo aggiungi la riga indicata alla fine della stessa macro
per togliere la selezione della riga formattata

Codice: Seleziona tutto

esci: '<<< esistente
Call Formato '<<<< esistente
Cells(RigaN, 4).Select '<<<< aggiungere
End Sub

Ciao

P.s. Penso che l'uomo non sia fatto per eseguire operazioni ripetitive

[raimea]

1.000 grazie
ottimo tutto ok
siete dei "geni"....