Macro pour déplacer une cellule contenant une valeur

[Sicut]

Bonjour à tous,

Dans une feuille Excel à la colonne D qui contient 50 000 cellules de valeurs ou de chaines alphanumériques, je souhaite identifier les cellules contenant une valeur et la déplacer d'une cellule à droite.
Voici le code que j'ai "bricolé":

Sub Macro4()
'
' Macro4 Macro
'
' Touche de raccourci du clavier: Ctrl+a
'
Dim i As Integer
Dim rngRange As Range

Set rngRange = Sheets("Test Sheet").Range("D1")
For i = 1 To 50000
If (rangeRange.Offset(i, 0).Value) <> "" Then
If IsNumeric(rangeRange.Offset(i, 0).Value) = True Then '<--Voici la syntaxe
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(1, 0).Range("A1").Select
End If
Next i
End Sub

Il me renvoie l'erreur suivante: Next sans For

Merci de votre aide!

 

[Dranreb]

Re : Macro pour déplacer une cellule contenant une valeur

Bonsoir.

Oh vous savez, c'est parce qu'il vous fait trop confiance: ça le conduit à être persuadé qu'il ne manque pas de End If correspondant au If (rangeRange.Offset(i, 0).Value) <> "" Then: il est seulement certainement plus loin voilà tout !
Alors en attendant, il a raison: c'est vrai qu'à partir de ce If là, il n'y a aucun For qui justifierait un Next avant ce fameux End If tant espéré, lequel manque tout à fait d'ailleurs et donc notamment avant le Next i

Pour le If qui suit, le = True est de trop. C'est en quelque sorte un pléonasme logique parce que :
True = True c'est True,
False = True c'est False, et par conséquent:
IsNumeric(rangeRange.Offset(i, 0).Value) = True c'est IsNumeric(rangeRange.Offset(i, 0).Value) tout seul.
Pourquoi pas If IsNumeric(rangeRange.Offset(i, 0).Value) = True = True = True = True = True = True Then à ce compte là ?
Et pareil: IsNumeric(rangeRange.Offset(i, 0).Value) = False ce serait Not IsNumeric(rangeRange.Offset(i, 0).Value).

 

[Sicut]

Re : Macro pour déplacer une cellule contenant une valeur

Bonjour Danreb,

Merci pour votre réponse pleine d'humour.
J'ai bien saisi le pléonasme.
En revanche pour le

End if
Next i

Je ne vois pas où le placer. J'ai fait ceci mais ça me renvoie toujours "next sans for":


Sub Macro4()
'
' Macro4 Macro
'
' Touche de raccourci du clavier: Ctrl+a
'
Dim i As Integer
Dim rngRange As Range

Set rngRange = Sheets("Test Sheet").Range("D1")
For i = 1 To 50000
If (rangeRange.Offset(i, 0).Value) <> "" Then
End If
Next i
If IsNumeric(rangeRange.Offset(i, 0).Value) Then
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Offset(1, 0).Range("A1").Select
End If
Next i
End Sub

 

[Dranreb]

Re : Macro pour déplacer une cellule contenant une valeur

Bonjour

Ben là non, comme ça il ne sert à rien le If avec des parenthèses en trop, soit dit aussi entre parenthèses, puisque son End If vient immédiatement derrière. Et là c'est vraiment un Next sans For tout à la fin.

Pourquoi ne feriez vous pas ça avec un tableau dans lequel vous chargeriez tout au début et que vous déchargeriez à la fin au même endroit ? Ce serait environ 20000 fois plus rapide, la durée d'exécution étant surtout proportionnelle au nombre de fois qu'on accède à une ou plusieurs cellules et non au nombre de valeurs de cellules transférées à chacun des accès.

 

[hbenalia]

Re : Macro pour déplacer une cellule contenant une valeur

Bonjour à tous,

Quelques changements dans le code ont été appliqués, dont l'énoncé serait le suivant:

Sub Macro4()
 '
 ' Macro4 Macro
 '
 ' Touche de raccourci du clavier: Ctrl+a
 '
Dim i As Long
Dim rngRange As Range
Application.ScreenUpdating = False
Sheets("Test Sheet").Range("D1").Select
Set rngRange = Sheets("Test Sheet").Range("D1")
For i = 1 To 50000
    If IsNumeric(Selection.Value) And Selection.Value <> "" Then
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    End If
    If Not IsNumeric(Selection.Value) Or Selection.Value = "" Then rngRange.Offset(i, 0).Select _
    Else: rngRange.Offset(i - 1, -1).Select
Next i
Application.ScreenUpdating = True
End Sub

NB: L'exécution du code se fera deux fois (pas trouvé mieux) si la cellule D1 contenait une valeur numérique (la première exécution décalera la valeur de D1 en E1 et la deuxième exécution décalera le reste de toutes les autres valeurs numériques de la colonne D à la colonne E (pour éviter cela, on laissera la cellule D1 vide en copiant manuellement sa valeur en cellule E1)... Une seule exécution du code dans les autres cas (cellule D1 vide ou contenait un texte alphanumérique)...

Cordialement

 

[hbenalia]

Re : Macro pour déplacer une cellule contenant une valeur

Bonjour à tous,

Une simplification du code précédent pour permettre son exéution en une seule fois dans tous les cas:

Sub Macro4()
 '
 ' Macro4 Macro
 '
 ' Touche de raccourci du clavier: Ctrl+a
 '
Dim i As Long
Application.ScreenUpdating = False
For i = 1 To 50000
    If IsNumeric(Cells(i, "D").Value) And Cells(i, "D").Value <> "" Then
        Cells(i, "D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    End If
Next i
Application.ScreenUpdating = True
End Sub

Cordialement

 

[Dranreb]

Re : Macro pour déplacer une cellule contenant une valeur

D'après ce que moi j'ai compris du problème (mais bien sûr on est toujours complètement à coté de la plaque quand il n'y a pas de classeur joint) ce serait ça :

Dim Plg As Range, T(), L As Long
Set Plg = Worksheets("Test Sheet").[D1:E5000]
T = Plg.Value
For L = 1 To 5000
   If IsNumeric(T(L, 1)) Then T(L, 2) = T(L, 1): T(L, 1) = Empty
   Next L
Plg.Value = T