3 votes

Sélection d'une plage de cellules et insertion d'une ligne vierge pour chaque nombre dont la séquence de ces cellules est décalée.

J'ai une colonne de plus de 19 000 lignes. Ce que je cherche à faire, c'est exécuter un code vba qui sélectionnera une plage de cellules dans cette colonne et ajoutera une ligne vierge pour chaque numéro manquant dans la séquence au sein de la plage sélectionnée. Pour l'instant, le code avec lequel je travaille me permet de sélectionner une plage de cellules, mais une fois que j'ai sélectionné cette plage, je reçois une erreur de type pour la ligne gap = Right(.Cells(i), 5) - Right(.Cells(i - 1), 5) . Si je prends la plage de cellules et que je la copie dans une nouvelle feuille, le code fait exactement ce que je veux qu'il fasse. Une idée de la raison pour laquelle j'obtiens une erreur de concordance lorsque je l'exécute sur la colonne contenant plus de 19 000 cellules ?

Le code avec lequel je travaille est le suivant :

Option Explicit

Sub InsertNullBetween()
Dim i As Long, gap As Long
'Update 20130829
Dim WorkRng As Range
Dim Rng As Range
Dim outArr As Variant
Dim dic As Variant
Set dic = CreateObject("Scripting.Dictionary")
'On Error Resume Next
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", WorkRng.Address, Type:=8)
With Range("A1", Cells(Rows.Count, 1).End(xlUp))
    For i = .Rows.Count To 2 Step -1
        gap = Right(.Cells(i), 5) - Right(.Cells(i - 1), 5)
        If gap > 1 Then .Cells(i).Resize(gap - 1).Insert xlDown 
    Next
End With
End Sub

1voto

user3598756 Points 25572

Développer plus en détail ma réponse en commentaire et refactoriser un peu votre code au minimum requis :

Option Explicit

Sub InsertNullBetween()
    Dim i As Long, gap As Long
    Dim WorkRng As Range

    On Error Resume Next
    Set WorkRng = Application.InputBox(Prompt:="Range To Check", Title:="Select a Range", Default:=Selection.address, Type:=8)
    On Error GoTo 0
    If WorkRng Is Nothing Then Exit Sub '<--| check user hasn't canceled the dialog box
    With WorkRng
        For i = .Rows.count To 2 Step -1
            gap = Right(.Cells(i), 5) - Right(.Cells(i - 1), 5)
            If gap > 1 Then .Cells(i).Resize(gap - 1).Insert xlDown
        Next
    End With
End Sub

Prograide.com

Prograide est une communauté de développeurs qui cherche à élargir la connaissance de la programmation au-delà de l'anglais.
Pour cela nous avons les plus grands doutes résolus en français et vous pouvez aussi poser vos propres questions ou résoudre celles des autres.

Powered by:

X