Recherche Partielle dans un Range/Cell indexé par une variable.

Version imprimable

16/11/2012, 22h12
gicquelmaxime

Recherche Partielle dans un Range/Cell indexé par une variable.
Bonjour à tous!

Alors je vais essayer d'être le plus précis précis dans la description de mon problème. Je précise que je suis débutant en VB, mais que j'ai soif de connaissance et hâte d'apprendre :)

J'aimerai faire une recherche partielle dans une cellule qui est indexée par une variable, cependant j'ai quelque petit souci avec la commande Cells, incompatible avec Like. Voici à quoi ressemble mon premier jet :

--------------------------------------------------------
Code:

1 2 3 4 5 6 7 8 Sub test1() l = ActiveSheet.UsedRange.Rows.Count For i=1 To l If Cells(i, "A").Value Like "*-->*" Then Cells(i, "F") = "Oui" End If Next i End Sub
--------------------------------------------------------

Apparemment Like fonctionne avec Range, mais je ne sais pas utiliser range et une variable en même temps.

J'ai ainsi changé d'optique et essayé de la manière suivante. Cette manière fonctionne mais me renvoi tout de même un message d'erreur...

--------------------------------------------------------
Code:

1 2 3 4 5 6 7 8 Sub test2() l = ActiveSheet.UsedRange.Rows.Count For i = 1 To l If InStr(1, ActiveSheet.Cells(i, 1), "-->", 1) > 0 Then Cells(i, "F")="Oui" End If Next i End Sub
--------------------------------------------------------

Afin que vous compreniez mieux ma démarche, voici mon but :
Sur ma feuille d'environ 2000 lignes, beaucoup d'entre elles sont de la forme :
AA:BB:CC,DDD --> EE:FF:GG,HHH
Je souhaite repérer ces cellules puis les décomposer comme suit :
AA,BB,CC,DDD,EE,FF,GG,HHH dans 8 colonnes indépendantes! Comme par exemple avec la fonction d'excel convertir à adapter en VB.

Merci d'avance pour votre aide.

Maxime

PS : Je dispose de microsoft excel 2003.

Edité à 23:17

Like n'a pas peur de Like
Évites de travailler avec Activesheet

Code

Code:

1
2
3
4
5
6
7
8
9
10
Sub test1()
Dim L As Long, i As Long
 
With Worksheets("Feuil1") 'Adapte au nom de ta feuille
    L = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 1 To L
        If .Cells(i, 1).Value Like "*-->*" Then .Cells(i, 6) = "Oui"
    Next i
End With
End Sub

EDIT

Une autre variante sans boucle utilisant des formules d'excel

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub Test3()
Dim L As Long
 
With Worksheets("Feuil1")                          'Adapte au nom de ta feuille
    L = .Cells(.Rows.Count, 1).End(xlUp).Row
    With .Range("F1:F" & L)
        .Formula = "=IF(ISNUMBER(FIND(""-->"",A2)),""Oui"","""")"
        .Value = .Value
    End With
End With
End Sub

Merci beaucoup, alors ces quelques lignes fonctionnent, enfin presque. En effet, j'ai bien mon message "oui" qui s'affiche en face de chacune des lignes concernées par "-->", cependant j'ai une erreur qui apparaît :

----------------------------------------------

Erreur d'exécution '13':
Incompatibilité de type.

----------------------------------------------

J'ai peur que pour la suite de mes opérations ce message ne me gène. En effet, je ne vais pas laisser le message "oui", mais procéder à la décomposition citée ci dessus.

Cette décomposition consiste à récupérer la cellule qui a été testée. Elle aura par exemple cette allure la :

00:00:02,819 --> 00:00:06,018
ou bien
00:10:25,941 --> 00:10:26,912

J'ai regardé comment s'interprete la fonction convertir d'excel en VB grâce à la fonction enregistrer une nouvelle macro, et j'obtiens ceci :

----------------------------------------------
Code:

1 2 3 4 5 6 7 Sub Macro1() Range("A6").Select Selection.TextToColumns Destination:=Range("F6"), DataType:=xlFixedWidth, _ FieldInfo:=Array(Array(0, 1), Array(2, 1), Array(3, 1), Array(5, 1), Array(6, 1), Array _ (8, 1), Array(9, 1), Array(12, 1), Array(17, 1), Array(19, 1), Array(20, 1), Array(22, 1), _ Array(23, 1), Array(25, 1), Array(26, 1), Array(29, 1)), TrailingMinusNumbers:=True End Sub
----------------------------------------------

Mon problème est que j'ai ici des Ranges et non des Cells, et ceci ne marche pas :

----------------------------------------------
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub test1() Dim L As Long, i As Long With Worksheets("Feuil2") L = .Cells(.Rows.Count, 1).End(xlUp).Row For i = 1 To L If .Cells(i, 1).Value Like "*-->*" Then Range(Cells(i,1)).Select Selection.TextToColumns Destination:=Range(Cells(1,19)), DataType:=xlFixedWidth, _ FieldInfo:=Array(Array(0, 1), Array(2, 1), Array(3, 1), Array(5, 1), Array(6, 1), Array _ (8, 1), Array(9, 1), Array(12, 1), Array(17, 1), Array(19, 1), Array(20, 1), Array(22, 1), _ Array(23, 1), Array(25, 1), Array(26, 1), Array(29, 1)), TrailingMinusNumbers:=True End If Next i End With End Sub
----------------------------------------------

Voici ainsi où je bloque. Mais je pense qu'il y a plus simple que d'utiliser une telle fonction issue d'excel. J'entends par plus simple un schéma plus simple, même si cela implique plus d'étape booléenne, ainsi je pourrai comprendre le fonctionnement et non le subir.

PS : je suis disponible sur skype sous le nom de "kk-nibal" si besoin. Toutes les réponses que j'obtiendrai par ce biais seront ensuite reportées sur le forum pour que ceux qui ont un problème identique puissent avoir une réponse.

Edité à 23:16

Essaies ceci, on expliquera ensuite. Je devine que tu veux séparer les heures, minutes et secondes vers les case de S à X

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub test1()
Dim L As Long, i As Long
 
With Worksheets("Feuil2")
    L = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 1 To L
        If .Cells(i, 1).Value Like "*-->*" Then
            .Range("A" & i).Copy .Range("S" & i)
            .Range("S" & i).Replace "-->", ":", xlPart
            Application.DisplayAlerts = False
            .Range("S" & i).TextToColumns Destination:=.Range("S" & i), DataType:=xlDelimited, Other:=True, OtherChar:=":"
            Application.DisplayAlerts = True
        End If
    Next i
End With
End Sub

EDIT (23:43)

Une autre proposition légèrement modifiée et commentée

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub test1()
Dim L As Long, i As Long
 
'On désactive le rafraichissement écran
Application.ScreenUpdating = False
With Worksheets("Feuil2")
    'Dernière cellule remplie de la colonne A
    L = .Cells(.Rows.Count, 1).End(xlUp).Row
    'On boucle sur toutes les lignes
    For i = 1 To L
        'Si la cellule Ai contient --> on transfère sa valeur vers la cellule Si
        'En remplaçant successivement --> par : et la virgule , par : et les espaces par du vide
        If .Range("A" & i).Value Like "*-->*" Then .Range("S" & i).Value = Replace(Replace(Replace(.Range("A" & i).Value, "-->", ":"), ",", ":"), " ", "")
    Next i
    'on descative les messages Excel au cas ou Si:Zi n'est pas vide
    Application.DisplayAlerts = False
    'On converti les données de la colonne S avec : comme séparateur
    .Range("S1:S" & L).TextToColumns Destination:=.Range("S1"), DataType:=xlDelimited, Other:=True, OtherChar:=":"
    'On réactive les messages Excel
    Application.DisplayAlerts = True
End With
End Sub

WOAHHHH! Cela à l'air si simple... Alors tout marche parfaitement, plus d'erreur ni rien. Cependant étant bientôt ingénieur, j'aime bien comprendre ce que je fais. C'est pourquoi j'aimerai revenir sur quelques points si possible. Surtout afin de pouvoir adapter ce code ultérieurement comme par exemple pour faire le chemin inverse, partir de 6 cases pour en reformer une seule!

------------------------------------------------
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub test1() Dim L As Long, i As Long With Worksheets("Feuil3") L = .Cells(.Rows.Count, 1).End(xlUp).Row For i = 1 To L If .Cells(i, 1).Value Like "*-->*" Then .Range("A" & i).Copy .Range("S" & i) 'copie "Ai" sur "Si" .Range("S" & i).Replace "-->", ":", xlPart 'remplace "-->" par ":", à quoi sert le xlPart? Application.DisplayAlerts = False '??? .Range("S" & i).TextToColumns Destination:=.Range("S" & i), DataType:=xlDelimited, Other:=True, OtherChar:=":" 'permet de séparer en 6colonnes, mais comment? Quelle serait la formule inverse? Application.DisplayAlerts = True '??? End If Next i End With End Sub
------------------------------------------------

Question Annexe :
Afin d'avoir toujours 3 chiffres dans la colonne S,T,V,W, j'ai créé ces quelques lignes qui marchent, mais sont-elles élégantes?

------------------------------------------------
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Sub Si() 'idem pour T,V,W Dim L As Long, i As Long With Worksheets("Feuil3") L = .Cells(.Rows.Count, 1).End(xlUp).Row For i = 1 To L If Cells(i, "S").Value < 100 And Cells(i, "S").Value >= 10 Then Cells(i, "S").Select Selection.NumberFormat = "0##" ElseIf Cells(i, "S").Value < 10 And Cells(i, "S").Value <> 0 Then Cells(i, "S").Select Selection.NumberFormat = "00#" ElseIf Cells(i, "S").Value = 0 Then Cells(i, "S").Select Selection.NumberFormat = "000" End If Next i End With End Sub
------------------------------------------------

N'ais-je pas la possibilité de faire les 3 conditions d'un coup, de plus dois-je faire 4 "Sub" (je ne connais pas son nom) pour les 4 lettres, en tout cas je ne vois pas comment puisque j'ai un test à réaliser sur chaque cellule.

Merci pour ta patiente, car je suis conscient d'en demander beaucoup!

------------------------------------------------

Ps : J'apprends vite, j'ai intégré ce code :
Code:

1 2 3 4 Dim L As Long, i As Long With Worksheets("Feuil3") L = .Cells(.Rows.Count, 1).End(xlUp).Row
Au lieu de celui-ci :

Code:

L = ActiveSheet.UsedRange.Rows.Count

Edité à 00:00

Essaies d'éviter au maximum les boucles et s'il y en a, optimises les aussi au maximum.

Sinon, pour la 2ème version avec formatage

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub test1()
Dim L As Long, i As Long
 
'On désactive le rafraichissement écran
Application.ScreenUpdating = False
With Worksheets("Feuil2")
    'Dernière cellule remplie de la colonne A
    L = .Cells(.Rows.Count, 1).End(xlUp).Row
    'On boucle sur toutes les lignes
    For i = 1 To L
        'Si la cellule Ai contient --> on transfère sa valeur vers la cellule Si
        'En remplaçant successivement --> par : et la virgule , par : et les espaces par du vide
        If .Range("A" & i).Value Like "*-->*" Then .Range("S" & i).Value = Replace(Replace(Replace(.Range("A" & i).Value, "-->", ":"), ",", ":"), " ", "")
    Next i
    'on descative les messages Excel au cas ou Si:Zi n'est pas vide
    Application.DisplayAlerts = False
    'On converti les données de la colonne S avec : comme séparateur
    .Range("S1:S" & L).TextToColumns Destination:=.Range("S1"), DataType:=xlDelimited, Other:=True, OtherChar:=":"
    'Formater les cellules en 00 et 000
    Union(.Range("S1:U" & L), .Range("W1:Y" & L)).NumberFormat = "00"
    Union(.Range("V1:V" & L), .Range("Z1:Z" & L)).NumberFormat = "000"
    'On réactive les messages Excel
    Application.DisplayAlerts = True
End With
End Sub

PS: Pour la question sur xlPart; n’oublie surtout pas d'utiliser F1 (c'est gratuit)

Citation:

expression.Replace(What, Replacement, LookAt, SearchOrder, MatchCase, MatchByte, SearchFormat, ReplaceFormat)

LookAt Facultatif Variante Il peut s'agir de l'une des constantes XlLookAt suivantes : xlWhole ou xlPart

xlPart Détecte une correspondance avec une partie du texte recherché.
xlWhole Détecte une correspondance avec l'ensemble du texte recherché.

17/11/2012, 00h23
gicquelmaxime

Avec cette deuxième version j'ai un problème, le même que cité ci dessus, lorsque j'arrive sur la ligne suivante :

Code:

If .Range("A" & i).Value Like "*-->*" Then .Range("S" & i).Value = Replace(Replace(Replace(.Range("A" & i).Value, "-->", ":"), ",", ":"), " ", "")

Cependant d’après la partie jaunie dans le débogage, l'erreur se trouve dans cette partie :

Code:

If .Range("A" & i).Value Like "*-->*" Then

Citation:

Envoyé par mercatog

PS: Pour la question sur xlPart; n’oublie surtout pas d'utiliser F1 (c'est gratuit)

En effet, mieux vaut profiter de cette gratuité, il n'est pas sur que dans les prochaines versions ce soit toujours le cas avec microsoft!

Edité = 00:23
17/11/2012, 01h17
gicquelmaxime

Alors, j'ai repris la première méthode en adaptant à mes données et tout fonctionne parfaitement!

Il ne me reste plus qu'une seule étape, j'aurai bien aimé trouver par mes propres moyens mais malheureusement la commande inverse de celle-ci n'existe pas...

Code:

.TextToColumns

Ainsi comment puis-je rassembler un certain nombre de colonnes (pas forcement côte à côte) en un seul texte dans une seule cellule, avec différent s séparateurs.

Par exemple, j'ai du texte dans les colonnes I,J,K,O,P,Q et je souhaite mettre ces textes bout à bout avec dans l'ordre ces séparateurs : ":",":"," --> ",":",":".

Ce qui nous donnerai donc : "I : J : K --> O : P : Q" (obligé de mettre des espaces pour ne pas faire de smileys...)

En gros l'inverse du début!

Edité à 13:46

Essaies comme ceci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub Test4()
Dim L As Long, i As Long
 
'On désactive le rafraichissement écran
Application.ScreenUpdating = False
With Worksheets("Feuil2")
    'Dernière cellule remplie de la colonne A
    L = .Cells(.Rows.Count, 1).End(xlUp).Row
    'On boucle sur toutes les lignes
    For i = 1 To L
        'Si la cellule Ai contient --> on transfère sa valeur vers la cellule Si
        'En remplaçant successivement --> par : et la virgule , par : et les espaces par du vide
        If .Range("A" & i).Text Like "*-->*" Then .Range("S" & i).Value = Replace(Replace(Replace(.Range("A" & i).Text, "-->", ":"), ",", ":"), " ", "")
    Next i
    'On test si on a au moin une donnée à convertir, sinon erreur
    If Application.CountA(.Range("S1:S" & L)) > 0 Then
        'on descative les messages Excel au cas ou Si:Zi n'est pas vide
        Application.DisplayAlerts = False
        'On converti les données de la colonne S avec : comme séparateur
        .Range("S1:S" & L).TextToColumns Destination:=.Range("S1"), DataType:=xlDelimited, Other:=True, OtherChar:=":"
        'Formater les cellules en 00 et 000
        Union(.Range("S1:U" & L), .Range("W1:Y" & L)).NumberFormat = "00"
        Union(.Range("V1:V" & L), .Range("Z1:Z" & L)).NumberFormat = "000"
        'On réactive les messages Excel
        Application.DisplayAlerts = True
    End If
End With
End Sub

PS: chaque cellule de A est disloquée en 8 cellules comme exprimé en #1 (heures, minutes, secondes, millisecondes)

Pour le chemin inverse, il suffit de faire une suite de concaténations

Alors voici ce que sa donne lorsque je regroupe toutes mes cellules, je ne sais pas si il y a plus simple mais cette méthode à la vertu de fonctionner, voici le code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Sub Concatener()
Dim L As Long, i As Long
 
With Worksheets("Feuil3")
    L = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 2 To L
    If Cells(i, "F") <> 0 Then
    Cells(i, "Z") = Cells(i, "I") & ":" & Cells(i, "J") & ":" & Cells(i, "K") & " --> " & Cells(i, "O") & ":" & Cells(i, "P") & ":" & Cells(i, "Q")
    End If
    Next i
End With
End Sub

Edité à 13:46

Sauf qu'avant Cells, mets un point pour indiquer que les cellules se rapportent à celle de Feuil3 que tu as mis avec With Worksheets("Feuil3")

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Sub Concatener()
Dim L As Long, i As Long
 
With Worksheets("Feuil3")
    L = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 2 To L
        If .Cells(i, "F") <> 0 Then
            .Cells(i, "Z") = .Cells(i, "I") & ":" & .Cells(i, "J") & ":" & .Cells(i, "K") & " --> " & .Cells(i, "O") & ":" & .Cells(i, "P") & ":" & .Cells(i, "Q")
        End If
    Next i
End With
End Sub

Pour t'expliquer le fonction de With, le même code peut être écris comme ceci

Code:

1
2
3
4
5
6
7
8
9
10
Sub ConcatenerBis()
Dim L As Long, i As Long
 
L = Worksheets("Feuil3").Cells(Worksheets("Feuil3").Rows.Count, 1).End(xlUp).Row
For i = 2 To L
    If Worksheets("Feuil3").Cells(i, "F") <> 0 Then
        Worksheets("Feuil3").Cells(i, "Z") = Worksheets("Feuil3").Cells(i, "I") & ":" & Worksheets("Feuil3").Cells(i, "J") & ":" & Worksheets("Feuil3").Cells(i, "K") & " --> " & Worksheets("Feuil3").Cells(i, "O") & ":" & Worksheets("Feuil3").Cells(i, "P") & ":" & Worksheets("Feuil3").Cells(i, "Q")
    End If
Next i
End Sub

Le With permet d'exécuter une série d'instructions appliquées à un seul objet ou à un type défini par l'utilisateur.