Code VBA - Inversion de l'ordre de report

Bonsoir,

La procédure ci-dessous déplace les lignes qui répondent à certains critères en fin de liste. Les lignes contrôlées sont de la ligne 11 à la dernière ligne utilisée.

Ca fonctionne parfaitement, ci se n'est que les lignes concernées sont reportées dans l'ordre numérique inverse (dans la colonne A où se trouve le critère de tri, les lignes reportées sont numérotée de l'infini à 1 alors qu'il serait mieux qu'elles soient reportées dans l'ordre de 1 à l'infini).

Est-il possible de corriger ceci sans grande complication ? Dans le cas contraire, cet inconvénient mineur pourrait être accepté.

Sub Controle_montant_impôt()

Dim i As Integer, Lig As Long, tablo

Application.ScreenUpdating = False
With Sheets("RepListeQuellensteuer")
    Lig = .Range("A65536").End(xlUp).Row ' Dernière ligne du tableau
    For i = Lig To 11 Step -1 ' Passage en revue
    If .Cells(i, 7) <> 0 And .Cells(i, 8) <> 0 Then
        If Round(.Cells(i, 8) / .Cells(i, 7), 3) <> 0.1 And Round(.Cells(i, 8) / .Cells(i, 7), 3) <> 0.045 Then
            tablo = Range(.Cells(i, 1), .Cells(i, 10))
            Rows(i).Delete
            Lig = .Range("A65536").End(xlUp).Row + 1
            Range(.Cells(Lig, 1), .Cells(Lig, 10)) = tablo
            .Cells(Lig, 9) = "?????"
        End If
    End If
    Next i
End With
End Sub

Bonnes salutations.

Hello,

tu peux mettre une partie de ton fichier , ca serait plus simple pour tester les eventuelles modif

Merci

Rebonjour,

Voici un fichier exemple :

https://www.excel-pratique.com/~files/doc/Sub_Controle_montant_impot.xls

Bonne soirée

Rebonjour,

Voici un fichier exemple :

https://www.excel-pratique.com/~files/doc/Sub_Controle_montant_impot.xls

Bonne soirée

A tout hasard

Sub Controle_montant_impôt()

Dim i As Integer, Lig As Long, tablo

Application.ScreenUpdating = False
With Sheets("RepListeQuellensteuer")
    ligne1 = Range("A65536").End(xlUp).Row ' Dernière ligne du tableau
    For i = 11 To ligne1 ' Passage en revue
    If Cells(i, 7) <> 0 And Cells(i, 8) <> 0 Then
        If Round(Cells(i, 8) / Cells(i, 7), 3) <> 0.1 And Round(Cells(i, 8) / Cells(i, 7), 3) <> 0.045 Then
            tablo = Range(.Cells(i, 1), .Cells(i, 10))
            Rows(i).Delete
            Range(.Cells(ligne1, 1), .Cells(ligne1, 10)) = tablo
            Cells(ligne1, 9) = "?????"
        End If
    End If
    Next i
End With
End Sub

au faite ca marche??

Suistrop,

J'ai fais plusieurs essais de ton code et à chaque fois l'ordre est identique, mais incorrect ; les lignes sont reportées dans un ordre incompréhensible (colonne de gauche ci-dessous).

2026 Nom 27 Prénom 27 IT 98070 Capri Leone -396.65 54.10 ?????

2033 Nom 34 Prénom 34 ES 47195 La Flecha 1'576.25 197.05 ?????

2037 Nom 38 Prénom 38 FR 68440 Habsheim 1'338.10 152.85 ?????

2041 Nom 42 Prénom 42 FR 74100 Vétraz-Monthoux 556.25 85.65 ?????

2045 Nom 46 Prénom 46 CH 1205 Genève 1'042.05 128.90 ?????

2051 Nom 52 Prénom 52 ES 41719 El Palmar de Troya 3741.6 237.95 ?????

2055 Nom 56 Prénom 56 FR 3210 Souvigny 3595 399.5 ?????

2031 Nom 32 Prénom 32 IT 73050 Gemini 551.6 75.15 ?????

2039 Nom 40 Prénom 40 AT 8401 Kalsdorf 917.5 124.25 ?????

2047 Nom 48 Prénom 48 GR 48100 Kanali, Preveza 1192.25 165.25 ?????

2008 Nom 9 Prénom 9 ES 15142 Arteixo 2977.3 156.7 ?????

2043 Nom 44 Prénom 44 DE 14167 Berlin 1609.35 194.6 ?????

2035 Nom 36 Prénom 36 FR 71500 Bruailles 1'108.10 162.80 ?????

2053 Nom 54 Prénom 54 FR 11700 Puichéric 1'143.50 175.35 ?????

Merci quand même pour cette tantative. Bonne soirée.

Bonsoir,

en partant de ton code, et si j'ai bien compris, essaie avec ce code :

Sub Controle_montant_impôt()

Dim i As Integer, Lig As Long, tablo, x As Long

Application.ScreenUpdating = False
With Sheets("RepListeQuellensteuer")
    Lig = .Range("A65536").End(xlUp).Row ' Dernière ligne du tableau
    For i = Lig To 11 Step -1 ' Passage en revue
    If .Cells(i, 7) <> 0 And .Cells(i, 8) <> 0 Then
        If Round(.Cells(i, 8) / .Cells(i, 7), 3) <> 0.1 And Round(.Cells(i, 8) / .Cells(i, 7), 3) <> 0.045 Then
            x = x + 1
            tablo = Range(.Cells(i, 1), .Cells(i, 10))
            Rows(i).Delete
            Lig = .Range("A65536").End(xlUp).Row + 1
            Range(.Cells(Lig, 1), .Cells(Lig, 10)) = tablo
            .Cells(Lig, 9) = "?????"
        End If
    End If
    Next i
End With
Range("A" & (Lig - x + 1) & ":I" & Lig).Sort Key1:=Range("A" & (Lig - x + 1)), Order1:=xlAscending, Header:=xlNo
End Sub

Alors là, c'est parfait, Felix. C'est exactement le code dont j'avais besoin.

Je ne sais trop comment te témoigner ma reconnaissance.

Merci beaucoup !

Sub Controle_montant_impôt()

Dim i As Integer, Lig As Long, tablo
Dim tab_delete(500) As Double

Application.ScreenUpdating = False
With Sheets("RepListeQuellensteuer")
    ligne1 = Range("A65536").End(xlUp).Row ' Dernière ligne du tableau
    ligne2 = ligne1 + 1
    For i = 11 To ligne1 ' Passage en revue
    If Cells(i, 7) <> 0 And Cells(i, 8) <> 0 Then
        If Round(Cells(i, 8) / Cells(i, 7), 3) <> 0.1 And Round(Cells(i, 8) / Cells(i, 7), 3) <> 0.045 Then
            tablo = Range(.Cells(i, 1), .Cells(i, 10))
            Range(.Cells(ligne2, 1), .Cells(ligne2, 10)) = tablo
            Cells(ligne2, 9) = "?????"
            tab_delete(h) = i
            h = h + 1
            ligne2 = ligne2 + 1
        End If
    End If
    Next i
cpt = 0
For i = LBound(tab_delete) To UBound(tab_delete)
    If tab_delete(i) <> 0 Then
        Rows(tab_delete(i) - cpt).Delete
        cpt = cpt + 1
    End If
Next i
End With
End Sub

et la c est mieux???

j arrive trop tard bien vu felix

Suistrop,

Mais merci quand même pour cette nouvelle version.

A bientôt, peut-être