Résolu code vba excel

globulle93

Habitué
bonjour a tous

je voudrais faire un code vba excel pour chercher "exemple chercher en cellule d2 si j'ai paris parmis une multitude d'info et inscrire dans cellule f2 75 et faire ca sur toute les ligne tant quelle ne sont pas vide. j'ai commencer en faisant du if avec like car j'ai vue que apparement le case et le like ne peuvent pas marcher. merci de votre aide et si vous avez des réference de livre pour apprendre le vba pour excel je suis preneur.

j'avais commencer avec du if range("d2").value like "*paris*" then range("f2").value = 75 end if

je doit rechercher différente dans toutes mes ligne d2 d3 etc et recopier une autre info en f2 f3 etc les differents teste se font tant que la ligne n'est pas vide.

je sais pas si je suis très claire :pt1cable:
 

tantal_fr

Grand Maître
Meilleure réponse
Bonjour,

En fait tu as besoin de faire une boucle. Connais-tu le nombre de ligne à traiter, ou bien c'est variable ?
Si tu dois faire une boucle, il y deux façons de faire : avec une boucle for each ou une boucle for classique. Personnellement, je préfère for each que je trouve plus élégant et moins source d'erreurs :

Code:
dim cellule as range
For Each cellule In Range(Range("D2"), Range("D2").End(xlDown))
     ' faire ce qui doit être fait
      if cellule.value then ... etc.
Next cellule

PS : n'hésite pas à mettre ton code dans les balises [ code=vb][/code], c'est plus lisible et conforme aux règles de ce forum ;)

Edit : correction (remplacement cells. par range.)
 

globulle93

Habitué
la boucle j'avais pas eu trop de mal j'en ai tester une avec
Code:
Dim libelle As Integer
        While Not IsEmpty(ActiveCell)
        libelle = libelle + 1
       Cells(libelle, 8).Select[
et une en while wend
mon problème était aussi dans le fait de faire le test if like ... et de copié une info d'une cellule dans une autre mais en modifiant l'info ex paris de la cellule d2 soit 75 dans la f2 mais j'ai une 40 aine de if a faire qui change d'info.
le code vb doit me faire le teste de tout les if sur toute les ligne et si j'ai
Code:
then range("f2")...
sur ma premiere ligne je recopie dans f2 mais après c'est en f3 etc ...donc y a une reference relative qui doit jouer ou je me trompe ?
j'ai pas tester ton code je le ferais demain.

pour répondre à ta question mon nombre de ligne est variable. si j'avais pu faire un case avec un like j'aurais eu moins de problème :heink:

 

tantal_fr

Grand Maître
Effectivement, là ce qu'il te faudrait c'est faire un select case.

Seulement, en temps normal select case ne fonctionne pas avec des like "**" mais il existe une astuce :

Code:
 Select Case True    ' astuce
        Case cellule.Value Like "*paris*"
            cellule.Offset(0, 2) = 75     'décalage de deux colonnes vers la droite
            '[...] etc.
        Case Else    ' Autres valeurs.
        Debug.Print "pas trouvé"
End Select
 

globulle93

Habitué
un grand merci a toi voila ma macro finit qui fonctionne super
Code:
Sub BNP_S341()
'
Dim libelle As Integer
While Not IsEmpty(ActiveCell)
libelle = libelle + 1
Cells(libelle, 8).Select
Select Case True
Case ActiveCell.Value Like "*5000*"
ActiveCell.Offset(0, 3) = 5000
Case ActiveCell.Value Like "*5001*"
ActiveCell.Offset(0, 3) = 5001
Case ActiveCell.Value Like "*5100*"
ActiveCell.Offset(0, 3) = 5100
Case ActiveCell.Value Like "*06041*"
ActiveCell.Offset(0, 3) = 5000
Case ActiveCell.Value Like "*GOBELI*"
ActiveCell.Offset(0, 3) = 5001
Case ActiveCell.Value Like "*ROSIERS*"
ActiveCell.Offset(0, 3) = 5000
Case ActiveCell.Value Like "*QUIMPER*"
ActiveCell.Offset(0, 3) = 5100

Case Else
Debug.Print ""
End Select
Wend

Range("h2").Select

End Sub
j'ai rajouter le range de fin pour repositionner ma selection sur ma zone de renseignement pour pouvoir relancer la macro quand je rajoute un case au fur à mesure de levolution de mon fichier.

dernier point tu connaitrais pas un bon bouquin sur le vba ou site car ceux que j'ai trouver était trop brouillon ou incomplet dans les explications.
encore un grand merci pour ton aide
 

tantal_fr

Grand Maître
Salut globulle93,

Je n'ai pas de référence à te donner pour ce qui est de livres. tu trouvera beaucoups de ressources sur Internet, par ex : http://excel.developpez.com/ ou http://fr.openclassrooms.com/ (ex-site du zero).

Concernant ton code, j'aurais quand même une remarque : éviter d'utiliser .Select et Selection. et utiliser une ref. explicite (ou une variable) car lorsque ta macro tourne, si la sélection change pour une cause extérieur, tu vas avoir des problème et ce sera difficile de savoir pourquoi.
L'indentation du code est aussi une bonne pratique pour une meilleure visibilité.

Code:
Dim libelle As Integer
libelle = 1
While Not IsEmpty(Cells(libelle, 8))
      Select Case True
        Case Cells(libelle, 8).Value Like "*5000*"
            Cells(libelle, 8).Offset(0, 3) = 5000

        Case Cells(libelle, 8).Value Like "*5001*"
            Cells(libelle, 8).Offset(0, 3) = 5001

        Case Cells(libelle, 8).Value Like "*5100*"
            Cells(libelle, 8).Offset(0, 3) = 5100

        Case Cells(libelle, 8).Value Like "*06041*"
            Cells(libelle, 8).Offset(0, 3) = 5000

        Case Cells(libelle, 8).Value Like "*GOBELI*"
            Cells(libelle, 8).Offset(0, 3) = 5001

        Case Cells(libelle, 8).Value Like "*ROSIERS*"
            Cells(libelle, 8).Offset(0, 3) = 5000

        Case Cells(libelle, 8).Value Like "*QUIMPER*"
            Cells(libelle, 8).Offset(0, 3) = 5100
        End Select
libelle = libelle + 1
Wend

Range("h2").Select
 
End Sub
 

globulle93

Habitué
bonjour,

j'ai un souci dans mes case j'ai des fois dans ma zone de recheche des infos en numérique et comme ca peut correspondre à 2 case different c'est le dernier qui prend le dessus mais n'est pas forcement le bon. y a t il un moyen pour palier à ce problème.

merci pour vos réponse
 

globulle93

Habitué
bonjour

bon après une bonne douche et un peut de réflexion j'ai trouver un moyen a mon problème :

comme j'ai d'autre zone je pensais faire des sous programme avec un teste

Code:
Sub BNP_SANDRO_1()

Dim CIB As Integer
CIB = 0
    If CIB = 4 Then
    Call especes
    ElseIf CIB = 2 Then
    Call cheques
    'ElseIf CIB = 30 Then
    'Call cartebleue
      Else
        End If
    
End Sub
 
    Sub especes()
 
Dim libelle As Integer
    libelle = 1
    While Not IsEmpty(Cells(libelle, 8))
    Select Case True
            
     Case Cells(libelle, 8).Value Like "*AVIGNON*"
    Cells(libelle, 8).Offset(0, 3) = 57
    
    Case Cells(libelle, 8).Value Like "*PARLY*"
    Cells(libelle, 8).Offset(0, 3) = 88
            
    Case Cells(libelle, 8).Value Like "*STHONORE2*"
    Cells(libelle, 8).Offset(0, 3) = 35
    
    Case Cells(libelle, 8).Value Like "*DEAUVILLE*"
    Cells(libelle, 8).Offset(0, 3) = 38
    
    Case Cells(libelle, 8).Value Like "*VIEUXCOLOMBIER*"
    Cells(libelle, 8).Offset(0, 3) = 47
    
    Case Cells(libelle, 8).Value Like "*ST GERMAIN EN LAYE*"
    Cells(libelle, 8).Offset(0, 3) = 23
    
    Case Cells(libelle, 8).Value Like "*0046*"
    Cells(libelle, 8).Offset(0, 3) = 46
    
    Case Cells(libelle, 8).Value Like "*MARSEILLE*"
    Cells(libelle, 8).Offset(0, 3) = 14
    
    Case Cells(libelle, 8).Value Like "*MONTPELLIER*"
    Cells(libelle, 8).Offset(0, 3) = 31
    
    Case Cells(libelle, 8).Value Like "*BORDEAUX*"
    Cells(libelle, 8).Offset(0, 3) = 11
    
    Case Cells(libelle, 8).Value Like "*LAVARENNE*"
    Cells(libelle, 8).Offset(0, 3) = 42
    
    Case Cells(libelle, 8).Value Like "*CANNESHOMMES*"
    Cells(libelle, 8).Offset(0, 3) = 92
    
    Case Cells(libelle, 8).Value Like "*VICTORHUGO*"
    Cells(libelle, 8).Offset(0, 3) = 72
    
    Case Cells(libelle, 8).Value Like "*POMPE*"
    Cells(libelle, 8).Offset(0, 3) = 41
    
    Case Cells(libelle, 8).Value Like "*SAINT HONORE*"
    Cells(libelle, 8).Offset(0, 3) = 25
    
    Case Cells(libelle, 8).Value Like "*PIERRE CHARON*"
    Cells(libelle, 8).Offset(0, 3) = 87
    
    Case Cells(libelle, 8).Value Like "*FRANCS BOURGEOIS*"
    Cells(libelle, 8).Offset(0, 3) = 26
    
    Case Cells(libelle, 8).Value Like "*TOULOUSEHOMME*"
    Cells(libelle, 8).Offset(0, 3) = 44
    
    Case Cells(libelle, 8).Value Like "*SOUFFLOT*"
    Cells(libelle, 8).Offset(0, 3) = 81
    
    Case Cells(libelle, 8).Value Like "*QUAIDEVALMY*"
    Cells(libelle, 8).Offset(0, 3) = 39
    
    Case Cells(libelle, 8).Value Like "*NICE*"
    Cells(libelle, 8).Offset(0, 3) = 40
    
    Case Cells(libelle, 8).Value Like "*LILLE*"
    Cells(libelle, 8).Offset(0, 3) = 12
    
    Case Cells(libelle, 8).Value Like "*NANCY*"
    Cells(libelle, 8).Offset(0, 3) = 62
    
    Case Cells(libelle, 8).Value Like "*DIJON*"
    Cells(libelle, 8).Offset(0, 3) = 29
    
    
    End Select
    libelle = libelle + 1
    Wend
     
    Range("h2").Select
     
    End Sub

   Sub cheques()
 
Dim libelle As Integer
    libelle = 1
    While Not IsEmpty(Cells(libelle, 8))
    Select Case True
            
     Case Cells(libelle, 8).Value Like "*AVIGNON*"
    Cells(libelle, 8).Offset(0, 3) = 57
    
    Case Cells(libelle, 8).Value Like "*PARLY*"
    Cells(libelle, 8).Offset(0, 3) = 88
            
            
    Case Cells(libelle, 8).Value Like "*0006*"
    Cells(libelle, 8).Offset(0, 3) = 6

          
    
    End Select
    libelle = libelle + 1
    Wend
     
    Range("h2").Select
     
    End Sub

puis je retourne dans le principale autre teste et retour dans un autre sous programme.

mais voila je comprend pas des fois ca marche, des fois non et pas de message d'erreur. Et quand ca marche il me traite mais 2 teste if avec la première liste de case like de especes :pt1cable::??:
une piste d'aide svp




[size=-1]moderator: EDIT =vb ajouté dans la balise code.[/size]
 

globulle93

Habitué
une nuit de dodo:D et je pense avoir la réponse mon if marche pas déja car je crée une variable que j'initialise mais je lui dit pas la cellule ou elle est donc un

Code:
if CIB range"f2"=4

serais ma solution et le fait qu'il exécutai mon code dans ma macro je devais être dans le sous programme pour ca qu'il la faisait et donc tenait pas compte de mon if et a la fin de mon if je lui dit d'incrementé.

j'ai trouvé ??:??:
 

tantal_fr

Grand Maître
Il semblerais que ce soit ça voici le code que je ferrais :
Code:
Sub BNP_SANDRO_1()
Dim CIB As Integer
    CIB = Range("F2").Value
    If CIB = 4 Then
        Call especes
    ElseIf CIB = 2 Then
        Call cheques
    'ElseIf CIB = 30 Then

    'Call cartebleue
        End If

 
End Sub
 

globulle93

Habitué
c'est ce que je pensais faire mais faut que je rajoute l'incrémentation pour passé de ligne ne ligne f2 f3 etc je teste et je te dirais

arf après teste j'ai un problème

Code:
    Sub BNP_SANDRO_1()
    [b]Dim CIB As Integer[/b] j'ai incompatibilite de type ici:??:
    CIB = Range("F2").Value
    If CIB = 4 Then
    Call especes
    ElseIf CIB = 2 Then
    Call cheques
    'ElseIf CIB = 30 Then
     
    'Call cartebleue
    End If
     
     
    End Sub


merci de ton aide :D
 

tantal_fr

Grand Maître
Bonjour,

Effectivement, si la valeur dans "F2" n'est pas un entier, ça lève une erreur. Tu as plusieurs solutions pour contourner l'erreur, je te conseil la fontion Val() qui converti une chaine en Int :

Code:
    Dim CIB As Integer
    CIB = Val(Range("F2").Value)
 

globulle93

Habitué
bonjour,

alors la je pige pas après mon
Code:
    Dim CIB As Integer
    CIB = Val(Range("F2").Value)
 If CIB = 4 Then
Call especes
ElseIf CIB = 2 Then
Call cheques
'ElseIf CIB = 30 Then
 
'Call cartebleue
End If
 
End Sub
à l'appel du call il bascule pas dans mon sub especes()
et autre intérogation je la fait comment mon incrementation pour qu'il me teste les valeurs de la colonne F pour faire toute mes ligne f2, f3 etc sachant que le nombre de ligne n'est pas fixe
dois je faire un teste si cellule non vide ...:??:

j'ai tester différent truc mais en débog je rentre déja pas dans le sub après le then donc coincé

merci de ton aide
 

tantal_fr

Grand Maître
Bonjour Globulle,

Lors du débogage, tu peux ajouter des espion sur des variables pour connaitre leurs valeurs et voir si elle se comportent bien.

Pour ton problème, je pense qu'il faut mettre ta boucle qui parcours tes lignes dans ta fonction BNP_SANDRO_1() et passer le numéro ligne en paramètre :
Code:
Sub BNPAAA()

     Dim CIB As Integer
     Dim ligne As Integer

    ligne = 1

    While Not IsEmpty(Cells(ligne, 6))
        CIB = Val(Cells(ligne, 6).Value)
        If CIB = 4 Then
            Call especes(ligne)
        ElseIf CIB = 2 Then
            Call cheques(ligne)
    'ElseIf CIB = 30 Then

    'Call cartebleue
        End If
    ligne = ligne + 1

    Wend

 
End Sub

 
Private Sub especes(libelle As Integer)

        Select Case True
            Case Cells(libelle, 8).Value Like "*AVIGNON*"
                Cells(libelle, 8).Offset(0, 3) = 57
 
            Case Cells(libelle, 8).Value Like "*PARLY*"
                Cells(libelle, 8).Offset(0, 3) = 88
 
                    '[...] ETC
 
            End Select
 
    End Sub

 
Private Sub cheques(libelle As Integer)


    Select Case True
 
        Case Cells(libelle, 8).Value Like "*AVIGNON*"
            Cells(libelle, 8).Offset(0, 3) = 57
 
        Case Cells(libelle, 8).Value Like "*PARLY*"
            Cells(libelle, 8).Offset(0, 3) = 88
            
                     '[...] ETC
 
    End Select
 
End Sub
 

globulle93

Habitué
bonjour tantral

je me pose une question

Code:
 Dim CIB As Integer
Dim ligne As Integer
 
ligne = 1
 
While Not IsEmpty(Cells(ligne, 6))
CIB = Val(Cells(ligne, 6).Value)
If CIB = 4 Then
Call especes(ligne)
ElseIf CIB = 2 Then
Call cheques(ligne)
'ElseIf CIB = 30 Then
 
'Call cartebleue
End If
ligne = ligne + 1
 
Wend
 
 
End Sub

si je voulais faire le même genre de teste mais que ma variable soit de type string y a le pendant de VAL car val concerne que les chiffres ??

merci de ton aide

 

tantal_fr

Grand Maître
Tu peux utiliser Cstr() (attention : déclarer CIB as string et comparer avec des valeurs entre double-cote "")
Code:
               Sub BNPAAA()
        
             Dim CIB As String   ' Chaine de caractère
             Dim ligne As Integer
        
            ligne = 1        
            While Not IsEmpty(Cells(ligne, 6))
                CIB = CStr(Cells(ligne, 6).Value)    ' conversion en string
                If CIB = "4" Then                           ' comparaison de string
                    Call especes(ligne)
                ElseIf CIB = "2" Then
                    Call cheques(ligne)
            'ElseIf CIB = 30 Then
        
            'Call cartebleue
                End If
            ligne = ligne + 1        
            Wend     
         
        End Sub

Une autre solution serait de déclarer CIB en variant mais il faut bien faire attention de faire des comparaison du bon type (cad ne pas mettre les "" quand on compare à un nombre):
Code:
        Sub BNPAAA()
        
             Dim CIB As Variant
             Dim ligne As Integer
        
            ligne = 1
        
            While Not IsEmpty(Cells(ligne, 6))
                CIB = Cells(ligne, 6).Value
                If CIB = 4 Then              'comparaison d'entier
                    Call especes(ligne)
                ElseIf CIB = "CHEQUES" Then  ' comparaison de string
                    Call cheques(ligne)
            'ElseIf CIB = 30 Then
        
            'Call cartebleue
                End If
            ligne = ligne + 1
            Wend
         
        End Sub
 

globulle93

Habitué
bonjour au grand maitre tantal :D

question du newbee

on peut faire des boucle à la suite ? mais la ou est le problème ce ne sont pas sur les même cellule comme tu peut le voir dans l'exemple

Code:
 Sub BNP_SANDRO()
     
    Dim CIB As Integer
    Dim ligne As Integer
    Dim code As String
    
    ligne = 1
     
    While Not IsEmpty(Cells(ligne, 10))              'première boucle 
    CIB = Val(Cells(ligne, 10).Value)
         
    If CIB = 4 Then
    Call especes(ligne)
        
    End If
    ligne = ligne + 1
     
    Wend
    
   While Not IsEmpty(Cells(ligne, 9))           ' boucle suivante
   code = Val(Cells(ligne, 9).Value)
     
    If code = "AM" And CIB = "" Then
    Call am(ligne)
    
    End If
        ligne = ligne + 1
    
     Wend
     
     End Sub
____________________________________________________________________________________________________ 
     Private Sub am(libelle As Integer)
     
     Select Case True
     
     Case Cells(libelle, 8).Value Like "*AVIGNON*"
     Cells(libelle, 8).Offset(0, 3) = 57
     
     Case Cells(libelle, 8).Value Like "*VICTOR*"
     Cells(libelle, 8).Offset(0, 3) = 72
     
     End Select
     
     End Sub
____________________________________________________________________________________________________     
    Private Sub especes(libelle As Integer)
     
    Select Case True
    
    Case Cells(libelle, 8).Value Like "*NANCY*"
    Cells(libelle, 8).Offset(0, 3) = 62
    
    Case Cells(libelle, 8).Value Like "*NICE*"
    Cells(libelle, 8).Offset(0, 3) = 40
    
    
    End Select
     
    End Sub


ca marche pas donc ca doit pas être la bonne méthode j'ai chercher sur goo est mon ami:D mais rien à ce sujet

De ce que j'ai suivie en mode débog le problème viendrait qu'après tout les case du premier while il resterait sur la dernière ligne du fichier qui est vide après le premier while et donc il passe au wend direct.

 

tantal_fr

Grand Maître

Tu vas me faire rougir :oops: d'autant que j'ai encore beaucoup à aprendre.


Il n'y a aucun problème à faire plusieurs boucles à la suite.



C'est exactement ce qu'il se passe !
Avec le débogueur, n'hésite pas à mettre des espions sur tes variables quant tu fait des pas à pas :



En suivant la variable ligne, celle-ci n'est pas remise à 1 avant d'attaquer la seconde boucle :pfff:

Ennsuite, tu vas avoir un soucis avec le test :
Code:
 If code = "AM" And CIB = "" Then
, la variable CIB aura la valeur que lui aura renvoyé la dernière ligne de la boucle précédente ce qui faussera ton programme.
 

globulle93

Habitué
bonjour tantal

à coté de moi tes un maitre
pour ramener ma selection après tout les case je fait ça

Code:
Range("h2").Select

je met après le wend

j'ai rajouter ça peut être pas très styler mais ca marche:D

sur le if code ="AM" and CIB="" then je veux que la boucle vérifie si ma cellule code = "AM" mais aussi que CIB ="" si elle est pas vide il sortira de la boucle après avoir parcouru les X ligne.

pour initialiser le CIB

Code:
CIB=0

mais ou le mettre et comment ?

j'ai tester mais il fait rien donc pas bon :heink:

bon bas vais creuser dans mes neurones

les espions j'ai chercher le fonctionnement mais j'ai pas tout finit de lire :)

bon j'ai fait ça mais je passe dans la deuxieme boucle mais je saute au wend direct

Code:
 Sub BNP_SANDRO()
 
Dim CIB As Variant
Dim ligne As Integer
Dim code As String
 
CIB = 0
ligne = 1
code = ""
 
While Not IsEmpty(Cells(ligne, 8)) 'première boucle
CIB = Cells(ligne, 10).Value
 
If CIB = 4 Then
Call especes(ligne)
 
End If
ligne = ligne + 1
 
Wend
 
 Range("h2").Select
 
 While Not IsEmpty(Cells(ligne, 8)) ' boucle suivante
code = CStr(Cells(ligne, 9).Value)
 
If code = "AM" And CIB = "" Then
Call am(ligne)
 
End If
ligne = ligne + 1
 
Wend
 
End Sub

___________________________________________________________________________________________________     
     Private Sub am(libelle As Integer)
     
     Select Case True
     
     Case Cells(libelle, 8).Value Like "*AVIGNON*"
     Cells(libelle, 8).Offset(0, 3) = 57
               
     End Select
     
     End Sub
__________________________________________________________________________________________________     
    Private Sub especes(libelle As Integer)
     
    Select Case True
    
    Case Cells(libelle, 8).Value Like "*NANCY*"
    Cells(libelle, 8).Offset(0, 3) = 62
          
    Case Cells(libelle, 8).Value Like "*NICE*"
    Cells(libelle, 8).Offset(0, 3) = 40
    
    End Select
     
    End Sub

 

tantal_fr

Grand Maître
Bonjour Globulle,

Entre les deux boucle, il faut remettre ligne à 1 sinon on part de la fin.

Dans ta deuxième boucle il faut mettre ce qu'il faut :
Code:
code = CStr(Cells(ligne, 9).Value)
CIB = Cells(ligne, 10).Value
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Derniers messages publiés
Statistiques globales
Discussions
730 134
Messages
6 718 062
Membres
1 586 394
Dernier membre
Manoushk
Partager cette page
Haut