Inverti righe

Hai un problema con Excel?

Nuova discussione

Inverti righe
di luciano (utente non iscritto) data: 17/05/2014 16:16:37
Salve. Nelle celle D14:H450 ho dei numeri, dovrei invertire le righe in questo modo: l'ultima riga cioè D450:H450 passare alla prima e cioè D14:H14, poi la penultima alla seconda eccetera. L'ultima riga attualmente è la 450 però quando inserisco nuovi valori diventa la 451 ecc...Grazie in anticipo

di lepat (utente non iscritto) data: 17/05/2014 16:56:16
uno dei tanti modi per farlo

Sub swaprows()
Dim i As Integer, j As Integer, temp As Integer, arr(), first As Integer, last As Integer
LR = Cells(Rows.Count, "D").End(xlUp).Row
Set Rng = Range("D14:H" & LR)
arr = Rng.Value
last = UBound(arr)
For i = 1 To last / 2
  temp1 = arr(last - i + 1, 1)
  temp2 = arr(last - i + 1, 2)
  arr(last - i + 1, 1) = arr(i, 1)
  arr(last - i + 1, 2) = arr(i, 2)
  arr(i, 1) = temp1
  arr(i, 2) = temp2
Next
Rng.Value = arr
End Sub

di lepat (utente non iscritto) data: 17/05/2014 17:14:24
la precedente macro inverte soltanto 2 colonne, prova questa

Sub swap_rows()
Dim arr()
LR = Cells(Rows.Count, "D").End(xlUp).Row
Set Rng = Range("D14:H" & LR)
last = Rng.Rows.Count
ReDim arr(last, 5)
For i = 1 To last
  For c = 1 To 5
    arr(i, c) = Rng(last - i + 1, c)
  Next
Next
Rng.Value = arr
End Sub

di luciano (utente non iscritto) data: 17/05/2014 19:43:46
Grazie per le risposte. Le ho provate entrambe, la prima come hai detto inverte solo le prime 2 righe mentre la seconda inverte 4 righe.

di scossa data: 17/05/2014 22:03:07
Ciao,
Questo codice, selezionato un range di almeno due righe, ne inverte l'ordine.

'---------------------------------------------------------------------------------------
' Procedure : InvertiRighe
' Author    : scossa
' Date      : 17/05/2014
' Purpose   : inverte le righe nel range selezionato
'---------------------------------------------------------------------------------------
'
Public Sub InvertiRighe()
  Dim rng As Range
  Dim rRow As Range
  Dim aRng As Variant
  Dim aInv As Variant
  Dim j As Long
  Dim k As Long
  Dim i As Long
  Dim nRows As Long
  Dim nCols As Long
  On Error GoTo Err_sub
  Set rng = Selection
  nRows = rng.Rows.Count
  nCols = rng.Columns.Count
  If nRows < 2 Then Err.Raise vbObjectError + 513, Description:="Selezionare almeno due righe."
  aRng = rng
  aInv = aRng
  For i = nRows To 1 Step -1
    j = j + 1
    For k = 1 To nCols
      aInv(j, k) = aRng(i, k)
    Next k
  Next
  rng = aInv
  rng.Cells(1, 1).Select
Err_sub:
  Set rng = Nothing
  If Err.Number <> 0 Then
    MsgBox Err.Description, vbCritical
  Else
    MsgBox "operazione terminata", vbInformation
  End If
End Sub

scossa's web site

Se tu hai una mela, ed io ho una mela, e ce le scambiamo, allora tu ed io abbiamo sempre una mela per uno.
Ma se tu hai un'idea, ed io ho un'idea, e ce le scambiamo, allora abbiamo entrambi due idee. (George Bernard Shaw)

di lepat (utente non iscritto) data: 18/05/2014 07:23:25
il copia incolla mi è riuscito male

Option Base 1
Sub swap_rows()
Dim arr()
LR = Cells(Rows.Count, "D").End(xlUp).Row
Set Rng = Range("D14:H" & LR)
last = Rng.Rows.Count
ReDim arr(last, 5)
For i = 1 To last
  For c = 1 To 5
    arr(i, c) = Rng(last - i + 1, c)
  Next
Next
Rng.Value = arr
End Sub

di luciano (utente non iscritto) data: 18/05/2014 16:31:34
@lepat hai reinserito pari pari la tua seconda macro, quella che non va perchè inverte quattro righe e cancella una riga e una colonna e quindi va sistemata.

@scossa la tua macro è fantastica, solo che nel mio caso ha l'inconveniente di selezionare tutto il range ogni volta.

di lepat (utente non iscritto) data: 18/05/2014 16:38:46
se quella di scossa ti va bene basta che tu sostituisca
Set rng = Selection
con
LR = Cells(Rows.Count, "D").End(xlUp).Row
Set Rng = Range("D14:H" & LR)

Public Sub InvertiRighe()
  Dim rng As Range
  Dim rRow As Range
  Dim aRng As Variant
  Dim aInv As Variant
  Dim j As Long
  Dim k As Long
  Dim i As Long
  Dim nRows As Long
  Dim nCols As Long
  On Error GoTo Err_sub
  LR = Cells(Rows.Count, "D").End(xlUp).Row 
  Set Rng = Range("D14:H" & LR)
  nRows = rng.Rows.Count
  nCols = rng.Columns.Count
  If nRows < 2 Then Err.Raise vbObjectError + 513, Description:="Selezionare almeno due righe."
  aRng = rng
  aInv = aRng
  For i = nRows To 1 Step -1
    j = j + 1
    For k = 1 To nCols
      aInv(j, k) = aRng(i, k)
    Next k
  Next
  rng = aInv
  rng.Cells(1, 1).Select
Err_sub:
  Set rng = Nothing
  If Err.Number <> 0 Then
    MsgBox Err.Description, vbCritical
  Else
    MsgBox "operazione terminata", vbInformation
  End If
End Sub

di luciano (utente non iscritto) data: 18/05/2014 17:04:41
Ok, l'ultima macro è quella che cercavo! Grazie mille

Vuoi Approfondire?