Inversione celle

Hai un problema con Excel?

Nuova discussione

Inversione celle
di twddesign (utente non iscritto) data: 12/06/2015 07:21:41
ciao atutti e ben trovati.
avrei necessita di fare una cosetta per semplificarmi la vira.
ho un file excel dove ci sono gli arrivi alle gare dei partecipanti.
ho la necessita spesso di spostare i corridori e di invertirli con altri dopo le verifiche video.
quindi ho necessita di modificare al volo e velocemente le righe sostituento e copianto...
Avrei la necessita di una macro che fa questo, con un bottone che mi permette di inserire solo i numeri cosi ogni volta non perdo 10 minuti a fare tutto cio ( devo normalmente fare 10/12 sostituzioni in media)
Prende i 2 numeri di corridori che gli do, e li scambia di posto. poi inserisco altri 2 e li scambia..e cosi via fino a quando non sistemo tutti nelle loro giuste posisizoni
Vi allego il file.
Ho evidenziato solo i valori che vanno scambiati di posto di colore verde. le celle da invertire sono quelle che vanno da B ad L ( tutto cio che è contenuto in esse )
Grazie mielle a tutti per la disponibilità.
Saluti.

Inversione celle
di twddesign (utente non iscritto) data: 12/06/2015 10:02:33
h trovato una specie di risoluzione a cio ma i dati vengono cancellati parzialmente.......forse devo formattarrli in un certo modo prima di modificarli ?

Public Sub SwapRanges()
Dim R1 As Range, R2 As Range, Rtemp As Range, Area As Areas
Dim Cell
Set Area = Selection.Areas
If Area.Count = 2 Then
    Set R1 = Area(1)
    Set R2 = Area(2)
Else
    MsgBox "Occorre aver prima selezionato i due intervalli da scambiare!"
End If
If R1.Columns.Count = R2.Columns.Count And R1.Rows.Count = R2.Rows.Count Then
    Set Rtemp = Range("ZZ1000").Resize(R1.Rows.Count, R1.Columns.Count)
    Rtemp.Value = R1.Value
    R1.Value = R2.Value
    R2.Value = Rtemp.CurrentRegion.Value
    Rtemp.ClearContents
Else
    MsgBox "I due intervalli devono essere uguali!"
End If
Set R1 = Nothing
Set R2 = Nothing
Set Rtemp = Nothing
End Sub

di Lucas87 data: 12/06/2015 10:16:43
Ciao
Prova così

Sub trova()
Dim ma()
ReDim ma(0)
pos1 = InputBox("Inserire il corridore 1: ")
pos2 = InputBox("Inserire il corridore 2: ")
If pos1 <> "" And pos2 <> "" Then
    Set fin1 = Columns(2).Find(what:=pos1, lookat:=xlWhole)
    Set fin2 = Columns(2).Find(what:=pos2, lookat:=xlWhole)
    If Not fin1 Is Nothing And Not fin2 Is Nothing Then
        c = Cells(1, Columns.Count).End(xlToLeft).Column
        For i = 2 To c
            ma(UBound(ma)) = Cells(fin1.Row, i)
            ReDim Preserve ma(UBound(ma) + 1)
        Next
        Range(Cells(fin1.Row, 2), Cells(fin1.Row, c)) = Range(Cells(fin2.Row, 2), Cells(fin2.Row, c)).Value
        For i = 1 To UBound(ma)
            Cells(fin2.Row, i + 1) = ma(i - 1)
        Next
    Else
        MsgBox "Corridori non trovati."
    End If
Else
    MsgBox "Valori non validi."
End If
End Sub

Inversione celle
di twddesign (utente non iscritto) data: 13/06/2015 08:11:10
non mi funziona da errore sub......
ho inserito il codice ma non capisco come farlo funzionare...
l'altra routine gia inserita fa lo swap ma mi modifica alcuni dati..
allego il file
di Lucas87 data: 13/06/2015 08:36:37
L'unico errore è dovuto alla mancanza della dichiarazione delle variabili.
Per farlo funzionare devi inserire il numero di pettorina dei corridori da scambiare (colonna B).
Dim pos1, pos2, c, i As Long Dim fin1, fin2 As Range
Inversione celle
di twddesign (utente non iscritto) data: 13/06/2015 09:12:38
mi dice che non è possibile eseguire il codice in modalità esecuzione.mah..
Inversione celle
di twddesign (utente non iscritto) data: 13/06/2015 09:15:05
ok risolto....sembra funzionate

Vuoi Approfondire?