Apparigliamento colonne Excel

  • Macro problema! di Gio
    Ciao a tutti e grazie in anticipo per l'aiuto!
    avrei un problema per il controllo di due colonne excel e credo qualche mago delle macro potrebbe aiutarmi a risolverlo! problema:
    ho due colonne di numeri crescenti a e b. devo controllare che le righe (n)corrispondenti contengano lo stesso dato (a1=b1;a2=b2; ecc..). quando invece il controllo restituisce che a(n)>b(n), il dato a(n) deve essere scalato in basso lasciando degli spazi vuoti (in caso di mancata corrispondenza nella colonna adiacente) fino a quando incontra il numero corrispondente in b(n). ugualmente se b(n)>a(n) b(n)viene scalato fino a che il controllo an=bn è vero. quindi continuare i controlli per le righe successive fino ad ottenere due colonne di dati con numeri uguali su righe uguali e celle vuote quando manca corrispondenza. (es. il num in a7 dovrebbe scalare lasciando spazio vuoto. quidi a8=b8;a9=b9;b10>a10 quindi il num in b10 scalare lasciando lo spazio vuoto. e così di seguito.
    credo che il codice vb sia abbastanza semplice per uno che ne sa....io a controlli e macro in excel divento pazzo!!!...grazie infinite!!!
     
    1	1	Abbassa Cursore  
    2	2	Abbassa Cursore
    3	3	Abbassa Cursore
    4	4	Abbassa Cursore
    5	5	Abbassa Cursore
    6	6	Abbassa Cursore
    7	6,5	Abbassa A1  
    8	7	Abbassa A1 
    8,5	8	Abbassa A1 
    9	9	Abbassa Cursore
    10	10	Abbassa Cursore
    

    ....errori... di Gio
    ....non guardate i controlli a fianco delle colonne perche sono sballati.

    di Mauro
    Solitamente non uso programmare vi do solo qualche dritta e vi lascio risolvere da soli. diciamo che sei stato fortunato!
    Sub apparigliamento()
    '
    Dim i As Integer, j As Integer, FineCol1 As Integer, FineCol2 As Integer
    Cells(1, 1).Select
    Selection.End(xlDown).Select
    FineCol1 = Selection.Row
    Cells(1, 2).Select
    Selection.End(xlDown).Select
    FineCol2 = Selection.Row
    
    i = 1
    j = 1
    Do Until Cells(i, 1).Text = "" Or Cells(j, 2).Text = ""
    Select Case True
    Case Cells(i, 1).Value < Cells(j, 2).Value
        Call scala(j, 2, FineCol1)
        FineCol1 = FineCol1 + 1
    Case Cells(i, 1).Value > Cells(j, 2).Value
        Call scala(i, 1, FineCol2)
        FineCol2 = FineCol2 + 1
    End Select
    i = i + 1
    j = j + 1
    Loop
    End Sub
    
    Sub scala(indrig As Integer, indcol As Integer, FineCol As Integer)
    
        For indi = FineCol To indrig Step -1
            Cells(indi + 1, indcol) = Cells(indi, indcol).Text
        Next
        Cells(indrig, indcol) = ""
    End Sub

    Grz di Gio
    Grazie mille spero di riuscire ad affinarlo da solo!...altrimenti proverò a ridisturbarti! grazie ancora infinitamente per ora!! ciao ciao