[VBA] Détection de 2 chaines identiques successives
Détection de 2 chaines identiques successives [VBA] - VB/VBA/VBS - Programmation
Sujets relatifs:
Leave a Replay
Make sure you enter the(*)required information where indicate.HTML code is not allowed
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.