Ajout et suppression en même temps(Avec Fichier Test)

Bonjour,

Voilà je possède un fichier qui analyse un fichier.txt, et selon si le fichier.txt a une ligne en plus ou moins cela ajoute ou supprime.

Cependant il m'est impossible d'effectuer à la fois un ajout et une suppression parce que mon code compte le nombre de ligne du tableau pour faire l'ajout ou la suppression et du coup cela me fausse mon comptage.

Mais il est possible d'ajouter une ligne lancer la macro puis supprimer une ligne est lancer la macro

Est-ce que vous avez un idée de comment faire ?

Si il y a aussi des améliorations je suis à votre écoute !

Voici la macro :(la macro fais d'autre truc est fonctionne mais pas pour l'ajout et la suppression simultanément)

Sub AnalysePing()
'
' AnalysePing Macro
'
' Variable Macro
'
' Dernière Ligne du tableau
Dim LastColumn As Integer
' Dernière Ligne du tableau
Dim LastLign As Integer
' Nombre Ligne dans le tableau
Dim NberL As Integer
' Ligne en cours d'analyse
Dim Ligne As Integer
'
'Variable PingResult2
' Dernière Ligne tableau
Dim LastLign2 As Integer
' Nombre Ligne dans le tableau
Dim NberL2 As Integer
' Ligne en cours d'analyse
Dim Ligne2 As Integer
'Variable Commune
Dim Difference As Integer
'Variable cellule pour la colorisation
Dim Cell As Object
'
'Désactiver déroulement à l'écran
Application.ScreenUpdating = False
'
' Definition des variables Initiales
LastColumn = 1
LastLign = 9
LastLign2 = 3
Difference = 0
Ligne = 9
Ligne2 = 3
'
' Copie Colonne Statut dans Comparatif avant l'analyse
  Range("Tableau113[Statut]").Select
    Selection.Copy
    Range("Tableau113[[Comparatif ]]").Select
    ActiveSheet.Paste
'
' Recheche de la dernière colonne Maquette3
Do
    LastColumn = LastColumn + 1
Loop While Cells(8, LastColumn).Value <> ""
LastColumn = LastColumn - 1
'
' Recheche de la dernière Ligne Maquette3
Do
    LastLign = LastLign + 1
Loop While Cells(LastLign, 1).Value <> ""
'
'Definir le nombre de ligne dans tableau Maquette3
NberL = LastLign - 9
'
'Ouverture du fichier PingResult2 trie en 2 colonnes
      Workbooks.OpenText Filename:="C:\Users\jbl7158\Desktop\PingResults.txt", Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, Semicolon:=True, Space:=False
'
' Recherche dernière ligne PingResults2
    Do
        LastLign2 = LastLign2 + 1
    Loop While Cells(LastLign2, 1).Value <> ""
' Definir nombre de ligne dans tableau Pingresults2
    NberL2 = LastLign2 - 3
' Si des Lignes ont été supprimés dans PingResults2
    If NberL2 < NberL Then
' Definir le nombre de ligne de difference
        Difference = NberL - NberL2
' Tant qu'on a des différences ou qu'on a pas vérifié chaque ligne de PingResults2
        While Ligne2 <= LastLign2 And Difference > 0
' Si le nom du site sur Maquette3 n'est pas le meme
            If Windows("PingResults.txt").ActiveSheet.Cells(Ligne2, 2).Value <> Windows("TEST.xlsm").ActiveSheet.Cells(Ligne, 2).Value Then
'
' On supprime la ligne
                Windows("TEST.xlsm").ActiveSheet.Rows(Ligne).EntireRow.Delete
                Ligne2 = Ligne2 - 1
                Ligne = Ligne - 1
                Difference = Difference - 1
                LastLign = LastLign - 1
                NberL = NberL - 1
            End If
            Ligne2 = Ligne2 + 1
            Ligne = Ligne + 1
        Wend
'
' Si toutes les lignes de Pingresults2 ont été supprimés, on supprime tous les lignes restantes de Maquette3
        While Difference <> 0
            Windows("TEST.xlsm").ActiveSheet.Rows(Ligne).EntireRow.Delete
            Difference = Difference - 1
        Wend
    Else
        If NberL2 > NberL Then
'
' Definir le nombre de ligne de difference
        Difference = NberL2 - NberL
' Tant qu'on a des différences ou qu'on a pas vérifié chaque ligne de PingResults2
        While Difference > 0
' Si le nom du site sur Maquette3 n'est pas le meme
            If Windows("PingResults.txt").ActiveSheet.Cells(Ligne2, 2).Value <> Windows("TEST.xlsm").ActiveSheet.Cells(Ligne, 2).Value Then
'
' On ajoute la ligne
                Windows("TEST.xlsm").ActiveSheet.Rows(Ligne).EntireRow.Insert
                Windows("PingResults.txt").ActiveSheet.Cells(Ligne2, 2).Copy
                Windows("TEST.xlsm").ActiveSheet.Cells(Ligne, 2).PasteSpecial Paste:=xlValues
                Difference = Difference - 1
                LastLign = LastLign + 1
                NberL = NberL + 1
            End If
            Ligne2 = Ligne2 + 1
            Ligne = Ligne + 1
        Wend
        End If
    End If
'
' Copier l'ensemble des statuts dans PingResults2 et les coller dans Maquette3
    Cells(3, 1).Select
    NberL2 = NberL2 - 1
    Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(NberL2, 0)).Select
    Selection.Copy
    Application.DisplayAlerts = False
    Windows("TEST.xlsm").Activate
    Cells(9, 1).Select
    Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(NberL2, 0)).Select
    ActiveSheet.Paste
    Windows("PingResults.txt").Activate
    ActiveWindow.Close
    Application.DisplayAlerts = True
 '
    'Colorisation et comparatif des celulles
    Range("Tableau113[[Comparatif ]]").Select
    For Each Cell In Selection 'Pour chaque cellule dans la selection
    If Cell.Value = "2" Then 'Si la valeur = 2 alors
        Cell.Interior.ColorIndex = 22 'Colorie est saumon
    End If
     If Cell.Value = "" Then 'Si la valeur =  alors
        Cell.Interior.ColorIndex = 10 'Colorie est vert
    End If
    If Cell.Value = "1" Then 'Si la valeur = 1 alors
        Cell.Interior.ColorIndex = 46 'Colorie est orange
        If Cells(Cell.Row, 1).Value = 0 Then
            Cells(Cell.Row, 1).Value = 1
        End If
    End If
    If Cell.Value = "3" Then 'Si la valeur =  alors
        Cell.Interior.ColorIndex = 6 'Colorie est jaune
        Cells(Cell.Row, 1).Value = 3
    End If
    Next
'Réactiver déroulement à l'écran
Application.ScreenUpdating = True
End Sub

Voici les fichiers pour vos tests ! (Pensez à changer le chemin du fichier txt dans la macro !)

Bonjour,

Tu peux envoyer le fichier excel ?

Bonjour,

Oui étant donné que c'est des choses confidentielles que je traite j'ai créé un fichier exemple

Dans la macro penser à changer le chemin du fichier.txt

Je rajoute les fichiers dans mon premier message !

S'il y a aussi des amélioration à faire, je suis à votre écoute

Pour faire vite, tu ne peux pas faire le code en deux parties ? C'est à dire ouvrir le fichier texte, supprimer des lignes si besoin, fermer le fichier, le ré-ouvrir et ensuite créer les lignes qu'il faut ?

Le problème est dans le comptage de ligne ça risque de créer des bug et faire du traitement en plus ...

Imaginons que je supprime dans le fichier .txt SITE 11 et que je rajoute SITE5.5.

Lors du traitement de la macro cela va tout simple rien changé parce que pour le fichier excel le nombre de ligne reste le même alors que non ce n'est pas la même chose.

Du coup est-ce qu'il faudrait pas vérifier si les villes sont les mêmes dans le fichier excel et dans le fichier texte plutôt que de compter le nombre de ligne ? Juste pour que je comprenne bien, est-ce que c'est toi qui a fait le code ?

Oui ça serais une idée à exploiter ! Mais si la ville apparait 2 fois cela risque pas de créer des conflits.

Oui, on travaille à deux sur le code

Ok, je suis surpris parce que le code est très bien fait, je pense que vous devriez y arriver !

Ca va aller si vous modifiez vous-même le code du coup ?