Intérieure de fonction if

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour a tous,
Je vient vers vous car j'ai un petit problème,
Il y a plus d'un mois j'ai crée une multitude de programme vba excel
et hier je me suis rendu compte que ce que j'avais fait n'était pas tout a fait correcte

en gros mon programme va chercher une référence dans une base de donnée et importe le prix liée a cette référence,
Et il y a quelque référence dont je ne dois pas importer le prix

Pour ne pas que mon programme importe le prix pour ces référence j'ai mis la fond des cellules en couleur jaune (6) et je voudrait faire :
Si le fond de la cellule est jaune, alors on laisse tomber cette cellules
^^ bien sur ceci est en Français te je voudrait le mettre sous langage vba

Voici mon programme :

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
    Dim Fichier As String
    Fichier = Dossier_FOP
        Sheets("Départs").Select
 
  'Ouverture du fichier de prix (en caché)
        Dim xlApp As Object
        Set xlApp = CreateObject("Excel.Application")
        Dim xlWk As Workbook
        Set xlWk = xlApp.Workbooks.Open(Chemin_dossier_sources & Dossier_sources)
        Dim xlWs As Worksheet
        Set xlWs = xlWk.Worksheets(1)
        xlApp.Visible = True 
 
    For i = 11 To 81 Step 5
        Dim rngArticle As Range
        Dim myWs As Worksheet
        Set myWs = ThisWorkbook.ActiveSheet
        DerLig = myWs.Cells(Rows.Count, i).End(xlUp).Row 
    Set rngArticle = myWs.Range(myWs.Cells(4, i), myWs.Cells(DerLig, i))
 
        'Recherche de l'article dans l'autre fichier
        Dim rngArticleRecherche As Range
        Set rngArticleRecherche = xlWs.Range(xlWs.Range("A2"), xlWs.Range("A65536").End(xlUp))
 
        Dim rngRefTrouve As Range
        Dim cell As Range
 
        For Each cell In rngArticle
            Set rngRefTrouve = rngArticleRecherche.Find(cell.Value, , xlValues, xlWhole)
            If rngRefTrouve Is Nothing Then
            Else
                cell.Offset(, 1).Value = rngRefTrouve.Offset(, 1).Value
            End If
        Next
    Next
 
 
    'Libération des ressources (fermeture du fichier caché)
    Set xlWs = Nothing
    xlWk.Close (False)
    Set xlWk = Nothing
    xlApp.Quit
    Set xlApp = Nothing
End Sub

Cordialement !!
Et merci d'avance
(si vous trouvez qu'il manque d'explication, dites le, j'essayerais de répondre dans de bref délais)

21/01/2014, 18h22
electrons

Bonsoir,

Tu pourrais essayer d'inclure un code du style

Code:

If Cells(i, j).Interior.ColorIndex = 27 Then

Le code 27 est pour le jaune foncé mais tu pourrais trouver le code avec la création d'une macro avec enregistrement et en sélectionnant le jaune que tu as choisi. En visualisant la macro, tu auras le code exacte.
21/01/2014, 18h42
sharox

Oki merci bien, je vais tester ceci et je revient après pour vous dire quoi !! :)

Et effectivement cela ne fonctionne pas :(
A chaque fois il y a des couilles avec moi
22/01/2014, 03h05
nibledispo

interieur de fonction if
Bonjour,

As tu essayé ceci en ligne 30 :
Code:

1 2 If rngRefTrouve Is Nothing Or rngRefTrouve.Interior.ColorIndex = 6 Then
Cordialement,
22/01/2014, 08h00
sharox
Bonjour,

Oui je vient de l'essayé ce matin et il me met :
Variable objet ou variable de bloc with non définie
je ne comprend pas trop -_-

Merci pour les réponses jusque la !!

Personnellement je pense qu'il faut mettre le filtre (ce que je recherche a faire) avant la ligne 30
plutôt a ce niveau la :
Code:

1 2 Derlig = myWs.Cells(Rows.Count, i).End(xlUp).Row Set rngArticle = myWs.Range(myWs.Cells(4, i), myWs.Cells(Derlig, i))
Car c'est ces cellules qui sont mis en jaune.

Cordialement et encore merci

Tu pourrais peut-être commencer par faire une mini-macro avec dedans un :

Code:

Debug.Print Cells(i, j).Interior.ColorIndex

Pour connaître la vraie valeur de TON jaune (en remplaçant i et j par les coordonnées d'une de tes cellules jaunes).

Et tant que tu y es, ajouter quelques autres Debug.Print pour savoir si ton jaune ne serait pas du à d'autres propriétés de Interior. Par exemle
Code:

1 2 3 4 5 6 7 8 Debug.Print Cells(i, j).Interior.PatternColor[ Debug.Print Cells(i, j).Interior.PatternColorIndex Debug.Print Cells(i, j).Interior.PatternThemeColor Debug.Print Cells(i, j).Interior.ThemeColor Debug.Print Cells(i, j).Interior.InvertifNegative Debug.Print Cells(i, j).Interior.GradientStyle Debug.Print Cells(i, j).Interior.GradientType Debug.Print Cells(i, j).Interior.GradientColorType

22/01/2014, 10h45
sharox
Merci
Donc il n'y a que
Code:

1 2 3 4 Debug.Print Range("AT101").Interior.ColorIndex Debug.Print Range("AT101").Interior.PatternColor Debug.Print Range("AT101").Interior.PatternColorIndex
qui fonctionne
et ca me donne les valeurs :

6
16711935
-4105

Mais je savais déjà que le jaune était :

Code:

.Interior.ColorIndex = 6
22/01/2014, 12h59
nibledispo

interieur de fonction if

bonjour,

Si c'est "rngarticle" qui est jaune alors oui il faut mettre "rngarticle" en lieu et place de "rngreftrouve" en ligne 30.

Cela devrait fonctionner car précisément il est défini plus haut par "set ....", ce qui n'est pas le cas de "rngreftrouve".

cordialement,
22/01/2014, 13h54
sharox
Bonjour,

Donc je me suis dit que si je mettais toutes las variables a la ligne 30, ca devrait automatiquement fonctionner...

donc ligne 30 j'ai mis :
Code:

1 2 If rngRefTrouve Is Nothing Or rngArticle.Interior.ColorIndex = 6 Or rngArticleRecherche.Interior.ColorIndex = 6 Then Else
Il n'y a pas d'erreure de code, mais cela ne fonctionne pas
et si je met :
Code:

1 2 If rngRefTrouve Is Nothing Or rngArticle.Interior.ColorIndex = 6 Or rngArticleRecherche.Interior.ColorIndex = 6 Or rngRefTrouve.Interior.ColorIndex = 6 Then Else
et la il me met une erreur
Franchement merci a tous d'essayer de m'aide :(
je ne pige rien

bonjour,

pourquoi ce compliquer la vie tu as un code qui fonctionne!
ne le modifie pas mais ajoute ce que tu as besoin!

Code:

1
2
3
4
 If rngRefTrouve Is Nothing Then
Else
cell.Offset(, 1).Value = rngRefTrouve.Offset(, 1).Value
End If

Code:

1
2
3
If TypeName(rngRefTrouve) <> "Nothing" Then
    If rngRefTrouve.Interior.ColorIndex = 6 Then cell.Offset(, 1).Value = rngRefTrouve.Offset(, 1).Value
End If

HOOOO ...
en faite non cela ne fonctionne pas j'ai cru car sur mes cases jaune cela ne faisait plus rien mais la enfaite ca fait plus rien nul part ^^

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
    Dim Fichier As String
    Fichier = Dossier_F
        Sheets("feuil1").Select
 
  'Ouverture du fichier 2(en caché)
        Dim xlApp As Object
        Set xlApp = CreateObject("Excel.Application")
        Dim xlWk As Workbook
        Set xlWk = xlApp.Workbooks.Open(Chemin_dossier_sources & Dossier_sources)
        Dim xlWs As Worksheet
        Set xlWs = xlWk.Worksheets(1)
        xlApp.Visible = True 'rend la deuxieme fenêtre visible
 
    For i = 11 To 81 Step 5
 
        Dim rngArticle As Range
        Dim myWs As Worksheet
            Set myWs = ThisWorkbook.ActiveSheet
            Derlig = myWs.Cells(Rows.Count, i).End(xlUp).Row
            Set rngArticle = myWs.Range(myWs.Cells(4, i), myWs.Cells(Derlig, i))
 
 
            'Recherche de l'article dans l'autre fichier
            Dim rngArticleRecherche As Range
            Set rngArticleRecherche = xlWs.Range(xlWs.Range("A2"), xlWs.Range("A65536").End(xlUp))
            Dim rngRefTrouve As Range
            Dim cell As Range
 
            For Each cell In rngArticle
                Set rngRefTrouve = rngArticleRecherche.Find(cell.Value, , xlValues, xlWhole)
                If rngRefTrouve Is Nothing Then
                    If TypeName(rngRefTrouve) <> "Nothing" Then
                        If rngRefTrouve.Interior.ColorIndex = 6 Then
                        Else
                        cell.Offset(, 1).Value = rngRefTrouve.Offset(, 1).Value
                        End If
                    End If
                End If
            Next
    Next
 
    'Libération des ressources (fermeture du fichier caché)
    Set xlWs = Nothing
    xlWk.Close (False)
    Set xlWk = Nothing
    xlApp.Quit
    Set xlApp = Nothing
End Sub

22/01/2014, 14h57
nibledispo

interieur de fonction if

Bonjour,

Soyons clair : qui doit être jaune "rngreftrouve" ou "rngarchive" ?

Avant de poster le précédent message, j'ai fait un essai avec "rngarticle" initialisé avec "set...." et VBA comprenait bien ce qui lui était demandé.

Cordialement,

Code:

1
2
3
4
5
6
7
        For Each cell In rngArticle
            Set rngRefTrouve = rngArticleRecherche.Find(cell.Value, , xlValues, xlWhole)
            If rngRefTrouve Is Nothing Then
            Else
                If rngRefTrouve.Interior.ColorIndex <> 6 Then cell.Offset(, 1).Value = rngRefTrouve.Offset(, 1).Value
            End If
        Next

si ça fonctionnait et plus maintenant, c'est sur la ligne en rouge que ça bug

22/01/2014, 15h16
sharox

Enfaite j'ai deux fichier
dans le premier je tombe sur une référence, si elle est pas en jaune, alors on met le prix qu'on va chercher dans un autre fichier et si c'est en jaune on passe a la suivante.
c'est donc rngArticle qui est en jaune (enfin il me semble)

et oui c'est la ligne rouge qui va pas il m'a mis une erreur de block with.

Cordialement

Enfaite c'est le gros bordel c'est tout ou rien :(
Dans un cas rien ce passe et dans l'autre tout change...
il me faudrait le entre deux, mais je ne sais pas du tout comment faire, je fait des teste
22/01/2014, 15h24
Invité

peux tu me joindre les 2 fichier version réduite pour ne pas avoir de gros fichiers. si c'est du xlm zip les.
22/01/2014, 16h11
sharox

2 pièce(s) jointe(s)

oki je te met les liens de départ avec les noms des fichier :

Chemin_dossier_sources = chemin classeur sharox
Dossier_sources = classeur sharox

dans le fichier1 va voir vers AO100 je les ais mis exactement au même endroit que moi

Pièce jointe 135219

Pièce jointe 135220

mais je ne comprend pas,

Quand je passe sur la ligne :

Code:

If rngRefTrouve.Interior.ColorIndex <> 6 Then

Il me met une erreur d'exécution '91' :
Variable objet ou variable de bloc With non définie

Code:

1
2
3
4
5
6
For Each cell In rngArticle
    Set rngRefTrouve = rngArticleRecherche.Find(cell.Value, , xlValues, xlWhole)
     If TypeName(rngRefTrouve) <> "Nothing" Then
            If cell.Offset(, 1).Interior.ColorIndex <> 6 Then cell.Offset(, 1).Value = rngRefTrouve.Offset(, 1).Value
        End If
Next

interieur de fonction if

re....,

ton code est effectivement le bazar.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
n'est pas plutot le rouge ?
For Each cell In rngArticleRecherche
                Set rngRefTrouve = 
' ou est défini le rouge cell.value
rngArticleRecherche.Find(cell.Value, , xlValues, xlWhole)
                If rngRefTrouve Is Nothing Or rngArticle.Interior.ColorIndex = 6 Then
                Else
                    cell.Offset(, 1).Value = rngRefTrouve.Offset(, 1).Value
                End If
                    
            Next

je ne suis pas fin connaisseur mais il me semble qu'il y a beaucoup à revoir.

A+,

22/01/2014, 16h26
sharox

et bha ca a l'air de fonctionner, je vais re-tester

Merci beaucuppour l'aide en tout cas :)
22/01/2014, 16h35
nibledispo

interieur de fonction if

Qu'est-ce qui a l'aire de fonctionner ?

Voir 40 message(s) de cette discussion en une page