Tri de données textes

[azerty123]

Bonjour,

Je vous expose mon problème.

Je cherche à effectuer un tri sur un fichier texte que j'ai exporté sur excel (environ 10 000 lignes dans une seul colonne A).

Après un petit MsgBox pour prévenir du temps de traitement, je souhaite que :


- Si il trouve un cellule qui contient "Blabla", il copie la celule deux lignes en dessous et la copie juste à sa droite.

(Ex : Si A1 = 123Blablablou123, je veux qu'il copie A3 en B1). Et ceci pour toute la colonne A.


- Deuxièmement (une fois l'étape d'avant effectué) que si il trouve une cellule qui ne contient pas "!a", il la supprime, mais sans pour autant que il se décale avec l'étape précédente.

(Ex : Si
A1 = a!a
B1 = rt!
C1 = az
D1 = po!a

Je voudrais obtenir :
A1 = a!a
B1 =
C1 =
D1 = po!a


Voici mon travail :

Sub Bouton3_QuandClic()

Dim Rep As Integer
Rep = MsgBox("Cette opération peut prendre quelques minutes, Voulez-vous continuez ?", vbYesNo + vbQuestion, "Attention")
    
    If Rep = vbYes Then
    
        For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
            If Cells(i, 1) Like "*blabla*" Then
            Cells(i + 2, 1).Select
            Selection.Copy
            Cells(i + 2, 2).Select
            Selection.Paste
            End If
        Next
            
        For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
            If Not Cells(i, 1) Like "*!a*" Then
            If i > 7 Then Rows(i).Delete
            End If
        Next
        
    Else: Range("A1").Select
    
    End If
   
End Sub

EDIT : (i>7 car j'importe mon texte qu'à partir de la ligne 7 ! )


Cela me retourne l'erreur :

"Erreur d'execution '438':
Propriété ou méthode non géré par cet objet"

(Pour la ligne "Selection.Paste").

La cellule conscerné est bien séléctionné (i+2), mais la copie ne marche pas.



Merci d'avance pour votre aide,

Cordialement.

 

[laetitia90]

Re : Tri de données textes

bonjour azerty
met un fichier exemple plus simple avec quelques lignes & sur une autre feuille le resultat a obtenir

 

[azerty123]

Re : Tri de données textes

Bonjour,


Voici mon document en pièce jointe. Etant donné que les données sur lesquelles je travaille sont confidentiel, le document contient des données bidons, et seulement sur une dizaine de ligne. La macro doit fonctionner avec environ 10 000 lignes de données.

Donc, mon code ineficace pour ma macro :

Sub Bouton3_QuandClic()

Dim Rep As Integer
Rep = MsgBox("Cette opération peut prendre quelques minutes, Voulez-vous continuez ?", vbYesNo + vbQuestion, "Attention")
    
    If Rep = vbYes Then
    
        For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
            If Cells(i, 1) Like "*blabla*" Then
            Cells(i + 2, 1).Select
            Selection.Copy
            Cells(i + 2, 2).Select
            Selection.Paste
            End If
        Next
            
        For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
            If Not Cells(i, 1) Like "*!a*" Then
            If i > 7 Then Rows(i).Delete
            End If
        Next
        
    Else: Range("A1").Select
    
    End If
   
End Sub

Feuille 1 : Type de donnée que j'exporte à la base.

Feuille 2 : Resultat souhaité après le passage de la première condition.
Si il trouve un cellule qui contient "Blabla", il copie la celule deux lignes en dessous et la copie juste à sa droite

Feuille 3 : Resultat souhaité après le passage de la troisième condition.
si il trouve une cellule qui ne contient pas "!a", il la supprime, mais sans pour autant que il se décale avec l'étape précédente.



Merci d'avance,

Cordialement.

 

[laetitia90]

Re : Tri de données textes

re
comme je comprends
je demarre en a7 comme tu le precise important
Option Compare Text important en debut de module

Option Compare Text
Sub es()
 Dim i As Long, s As Long
 Application.ScreenUpdating = False
 s = Timer
 For i = 7 To Cells(Rows.Count, 1).End(xlUp).Row
 If Cells(i - 2, 1) Like "*blabla*" Then Cells(i - 2, 2) = Cells(i, 1)
 Next i
 For i = 7 To Cells(Rows.Count, 1).End(xlUp).Row
 If Not Cells(i, 1) Like "*a!*" And Cells(i, 2) = "" Then Cells(i, 1) = ""
 Next i
 MsgBox Timer - s
End Sub

code brut en simplifier on pourrait faire une seule boucle ou passer par un tablo plus rapide mais plus le temps de voir

 

[azerty123]

Re : Tri de données textes

Bonsoir,

A vrai dire, ton code me supprime 99.9% des lignes (il m'en reste 6 sur 16 338) et m'affiche 2,46875 ...
Est ce que ca peut etre du au fait qu'il y a des espaces en debut de chaque cellule (je ne pense pas que ca influe sur une coparaison mais bon) ?
A quoi sert le module CompareText?

Cordialement.

 

[laetitia90]

Re : Tri de données textes

re,

Option Compare Text

ne fait pas difference entre majuscule & minuscules
vu que tu ecris

Si il trouve un cellule qui contient "Blabla", il copie la celule deux lignes en dessous et la copie juste à sa droite

.

dans le code tu ecris

If Cells(i, 1) Like "*blabla*"

c'est pas pareil du tout?? le premier b en majuscule

autrement MsgBox Timer - s te donne le temps d'excution de la macro pas indispensable

avec l'exemple que tu donnes cela marche t'il ???? as tu fais un essai qst..

moi avec ton fichier cela marche en simplifiant un peu sans module CompareText mais en tenant compte de tes données pour like

Sub es()
  Dim i As Long
  Application.ScreenUpdating = False
  For i = 7 To Cells(Rows.Count, 1).End(xlUp).Row
  If Cells(i - 2, 1) Like "*Blabla*" Then Cells(i - 2, 2) = Cells(i, 1)
  If Not Cells(i, 1) Like "*a!*" Then Cells(i, 1) = ""
  Next i
End Sub

ps autre chose qui peut avoir une importance tes données d'origine c'est quoi comme format
dans l'exemple tu as fait une copy & modifier les noms???

 

[azerty123]

Re : Tri de données textes

Merci pour tes réponses, j'ai finalement réussi à m'en sortir à force de bidouiller, avec le code suivant :

Option Compare Text
Sub Bouton1_QuandClic()

'--------------------------------------------------------------------
    Dim I As Long
  
    Application.ScreenUpdating = False
  
    For I = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(I, 1) Like "*Blabla*" Then Cells(I, 2) = Cells(I + 2, 1)
    Next I
  
    For I = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    If Not Cells(I, 1) Like "*Blabla*" Then Cells(I, 1) = ""
    Next I
  
    Selection.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
 
    For I = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    If Not Cells(I, 2) Like "*Blabli*" Then Cells(I, 2) = ""
    Next I
  
    For I = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    If Not Cells(I, 2) Like "*Blablou*" Then Cells(I, 1) = ""
    Next I
  
    Selection.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
  
End Sub

Merci pour ton aide,

Cordialement.