[VBA] Détection de 2 chaines identiques successives

Détection de 2 chaines identiques successives [VBA] - VB/VBA/VBS - Programmation

Marsh Posté le 07-06-2006 à 10:45:50    

Bonjour
Voila le genre de fichier excel que je dois traiter :
6005,INFORMATIONAL,EventLog,Tue Jun 06 08:13:18 2006,No User,Event Description Not Found: Partial Description: No strings to display.
6006,INFORMATIONAL,EventLog,Fri Jun 02 17:01:01 2006,No User,Event Description Not Found: Partial Description: No strings to display.
6005,INFORMATIONAL,EventLog,Fri Jun 02 16:55:48 2006,No User,Event Description Not Found: Partial Description: No strings to display.
6005,INFORMATIONAL,EventLog,Fri Jun 02 16:44:15 2006,No User,Event Description Not Found: Partial Description: No strings to display.
6006,INFORMATIONAL,EventLog,Fri Jun 02 16:43:47 2006,No User,Event Description Not Found: Partial Description: No strings to display.
 
(si vous voulez savoir pourquoi je fais ca : http://forum.hardware.fr/hardwaref [...] 5854-1.htm )
 
Lorsqu'il y a 2 "6005" qui se suivent, il faut que je note la date du "6005" le plus récent dans un nouvelle feuille (il peut y avoir plus de 2 "6005" qui se suivent et plusieurs fois)  
 
Voila le code que j'ai réalisé jusqu'à présent :
 
 
Sub Excel()
 
Dim x, i As Double
Dim a, b, c, d, e, h As String
 
x = 1
 
Application.StatusBar = "Trie des informations.."
 
'Sélectionne l'avant derniere cellule au bas de la colonne
Cells(ActiveSheet.UsedRange.Rows.Count - 2, 1).Select
a = Selection.Value
c = Mid(a, 1, 4)
 
Do
If c = "6006" Then
         
        Do
        'Revoir la manipulation du x, il ne doit etre incrémenté que de 1
        x = x + 2
        Cells(ActiveSheet.UsedRange.Rows.Count - x, 1).Select
        a = Selection.Value
            For i = 1 To 4
            d = Mid(a, 1, 4)
            Next i
        Cells(ActiveSheet.UsedRange.Rows.Count - x - 1, 1).Select
        b = Selection.Value
            For i = 1 To 4
            e = Mid(b, 1, 4)
            Next i
         
        Loop While d = "6005" And e = "6006"
         
        If e = "6005" Then
        'Recopier date
            For i = 1 To 24
            h = Mid(b, 29, 24)
            Next i
        End If
         
        Cells(ActiveSheet.UsedRange.Rows.Count - x - 2, 1).Select
            a = Selection.Value
            For i = 1 To 4
            c = Mid(a, 1, 4)
            Next i
 
             
            'Copie dans une nouvelle feuille
            Dim nom As String
            nom = "Fichier_final"
            ActiveWorkbook.Sheets.Add
            ActiveSheet.Name = nom
            Sheets("Fichier_final" ).Select
 
            Cells(20, 10).Value = h
            Cells(20, 7).Value = "Démarrage du PC apres crash : "
 
Else
 
If c = "6005" Then
         
        Do
        x = x + 2
        Cells(ActiveSheet.UsedRange.Rows.Count - x, 1).Select
        a = Selection.Value
            For i = 1 To 4
            d = Mid(a, 1, 4)
            Next i
        Cells(ActiveSheet.UsedRange.Rows.Count - x - 1, 1).Select
        b = Selection.Value
            For i = 1 To 4
            e = Mid(b, 1, 4)
            Next i
        Loop While d = "6006" And e = "6005"
         
           
        If d = "6005" Then
        'Recopier date
            For i = 1 To 24
            e = Mid(a, 29, 24)
            Next i
        Cells(20, 10).Value = h
        End If
         
        Cells(ActiveSheet.UsedRange.Rows.Count - x - 1, 1).Select
            a = Selection.Value
            For i = 1 To 4
            c = Mid(a, 1, 4)
            Next i
           
            'Copie dans une nouvelle feuille
            Dim nom As String
            nom = "Fichier_final"
            ActiveWorkbook.Sheets.Add
            ActiveSheet.Name = nom
            Sheets("Fichier_final" ).Select
 
            Cells(20, 10).Value = h
            Cells(20, 7).Value = "Démarrage du PC apres crash : "
 
End If
End If
 
Loop While ActiveSheet.UsedRange.Rows.Count - x - 1 <> 1
 
End Sub
 
 
 
--> Lorsque je fais :              
Cells(20, 10).Value = h
Cells(20, 7).Value = "Démarrage du PC apres crash : "
Il me le met dans la feuille d'origine alors que je veux qu'il le place dans la nouvelle feuille que je viens de créer, comment faire ?
 
Puis comment faire pour qu'il le place à la premiere ligne vide ?
D'autres suggestions ?
Merci beaucoup.

Reply

Marsh Posté le 07-06-2006 à 10:45:50   

Reply

Marsh Posté le 09-06-2006 à 14:19:08    

Probleme résolu,Merci

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed