test sur valeur cellule mais ça fonctionne pas

[zorg]

Bonjour à tout le forum
une fois de plus j'ai un ch'tit souci en vba; j'ai parcouru en long en large et en travers les anciens messages mais rien à faire ça déconne

voici mon problème j'ai dans une colonne (A) et sur 6500 lignes environ une valeur dans chaque cellule ex: 106, 206, 307 , exp, box, par, 807 lqui peuvent se répéter et ne suive pas un ordre précis
Selon la valeur j'ai un traitement différent j'ai donc fait la macro suivante euh j'suis débutant donc ce n'est surement pas le code le plus efficace)

il n'y a que les cellules avec #N/A ou qui sont vides qui fonctionnent; le reste (valeur num ou text) n'est pas reconnu

est ce que qqu'un peut m'aider??


Sub Control_Famille()
Application.ScreenUpdating = False
Dim Famille As Integer
Dim Derligne As Integer

Derligne = 0

Sheets("Log").Select
Rows("2:65536").Select
selection.Delete Shift:=xlUp

Sheets("Encours").Select
Nbrligne = Range("A" & 65536).End(xlUp).Row

Val_NA = 0
Autre = 0
Vide = 0
Inconnue = 0

For Famille = 2 To Nbrligne
If IsError(Range("A" & Famille).Value) Then
Sheets("Log").Select
Derligne = Range("C" & 65536).End(xlUp).Row
Sheets("Encours").Select
Vide = Vide + 1
Rows(Famille).Select
selection.Copy
Sheets("Log").Select
Range("A" & Derligne + 1).Select
ActiveSheet.Paste
Sheets("encours").Select
selection.Delete Shift:=xlUp

ElseIf IsEmpty(Range("A" & Famille).Value) = True Then
Sheets("Log").Select
Derligne = Range("C" & 65536).End(xlUp).Row
Sheets("Encours").Select
Vide = Vide + 1
Rows(Famille).Select
selection.Copy
Sheets("Log").Select
Range("A" & Derligne + 1).Select
ActiveSheet.Paste
Sheets("encours").Select
Range("A" & Famille) = 0

ElseIf Range("A" & Famille).Value = "Autre" Then
Sheets("Log").Select
Derligne = Range("C" & 65536).End(xlUp).Row
Sheets("Encours").Select
Autre = Autre + 1
Rows(Famille).Select
selection.Copy
Sheets("Log").Select
Range("A" & Derligne + 1).Select
ActiveSheet.Paste
Sheets("encours").Select
Range("A" & Famille) = 0

ElseIf Cells(Famille, "A").Value <> "406" Or Cells(Famille, "A").Value <> "307" Then 'etc yen a d'autre pour ceux qui n'auraient pas reconnu les véhicules de la marque au Lion
Sheets("Log").Select
Derligne = Range("C" & 65536).End(xlUp).Row
Sheets("Encours").Select
Inconnue = Inconnue + 1
Rows(Famille).Select
selection.Copy
Sheets("Log").Select
Range("A" & Derligne + 1).Select
ActiveSheet.Paste
Sheets("encours").Select
Range("A" & Famille) = 0

End If

Next Famille

MsgBox "Vérification des familles véhicules terminée !" & Chr(10) & Chr(10) & _
Val_NA & " erreurs type : #N/A trouvées (lignes supprimées)" & Chr(10) & _
Vide & " erreurs type : Vide trouvées" & Chr(10) & _
Autre & " erreurs type : Autre trouvées" & Chr(10) & _
Inconnue & " erreurs type : inconnue trouvées" & Chr(10) & Chr(10) & _
"Chaque erreur est recopiée dans Feuil!Log", vbInformation, "Vérification des familles"
Application.ScreenUpdating = True

End Sub

 

[sousou]

Bonjour.

Un peu usine à Gaz !
quelques infos en vrac, car il est difficile de te répondre sans le fichier.

Tu remarquera que beucoup de chose sont identiques dans ton code, il y à matière à élaguer en utilisant des procedures communes.

Tu pourrais utiliser select case pour te facilité la vie.

N'oublie pas que tu n'est pas toujours obligé de selecter une cellule pour la manipuler
ex:
set ma cellule= sheets("toto").range("a1")
macellule.clear
macellule .offset(1,1)=0
macellule.entirerow.delete
etc...

Utilise les boucles for each dans une plage définie
Ex
set maplage= activesheet.usedrange.columns(1)
for each donnée in maplage
...
next
A suivre

 

[zorg]

je suis d'accord avec toi Sousou il y a pas mal de parties du code redondante (je le simplifierais plus tard )
voici un extrait du fichier xls que je dois traiter

en résumé je dois trouve en colonne A les cellules avec #N/A, celles vides, celles avec Autre et celles dont la valeur est différente 106,206,306,307,406,407,806,807
chaque ligne doit etre sélectionnée et copié dans la feuille "Log"
les lignes avec #N/A sont supprimées de la source

pour #N/A et vide ça fonctionne mais pas pour le reste

merci pour ton aide

 

[le Fnake]

bonjour zorg, sousou, le forum

comme le dit sousou, sans fichier, c'est dur de se rendre de ce qui marche pas et de voir ce que tu veux faire. Je tente malgré tout une petite version allégée de ta macro (sous couvert d'erreurs de frappe, vu que je n'ai pu le tester) :


Sub control_Famille2()
Application.ScreenUpdating = False
Dim Famille As Integer
Dim DerligneLog As Integer

Sheets("Log").Rows("2:65536").Select
Selection.Delete Shift:=xlUp
Nbrligne = Sheets("Encours").Range("A" & 65536).End(xlUp).Row

DerligneLog = 2: Val_NA = 0: autre = 0: Vide = 0: Inconnue = 0

For Famille = 2 To Nbrligne
If IsError(Range("A" & Famille).Value) Then
DerligneLog = DerligneLog + 1
Val_NA = Val_NA + 1
Rows(Famille).Select
Selection.Copy Destination:=Worksheets("Log").Range("A" & DerligneLog)
Selection.Delete Shift:=xlUp

ElseIf IsEmpty(Range("A" & Famille).Value) Then
DerligneLog = DerligneLog + 1
Vide = Vide + 1
Rows(Famille).Select
Selection.Copy Destination:=Worksheets("Log").Range("A" & DerligneLog)
Range("A" & Famille) = 0

ElseIf Range("A" & Famille).Value = "Autre" Then
DerligneLog = DerligneLog + 1
autre = autre + 1
Rows(Famille).Select
Selection.Copy Destination:=Worksheets("Log").Range("A" & DerligneLog)
Range("A" & Famille) = 0

ElseIf Cells(Famille, "A").Value <> "406" Or Cells(Famille, "A").Value <> "307" Then 'etc yen a d'autre pour ceux qui n'auraient pas reconnu les véhicules de la marque au Lion

DerligneLog = DerligneLog + 1
Inconnue = Inconnue + 1
Rows(Famille).Select
Selection.Copy Destination:=Worksheets("Log").Range("A" & DerligneLog)
Range("A" & Famille) = 0
End If

Next Famille

Application.ScreenUpdating = True
MsgBox "Vérification des familles véhicules terminée !" & Chr(10) & Chr(10) & _
Val_NA & " erreurs type : #N/A trouvées (lignes supprimées)" & Chr(10) & _
Vide & " erreurs type : Vide trouvées" & Chr(10) & _
autre & " erreurs type : Autre trouvées" & Chr(10) & _
Inconnue & " erreurs type : inconnue trouvées" & Chr(10) & Chr(10) & _
"Chaque erreur est recopiée dans Feuil!Log", vbInformation, "Vérification des familles"

End Sub

 

[zorg]

bonjour le Fnake (ça me fait rigoler mon frère a le meme surnom ;-D )
merci de te pencher toi aussi sur mon pb
ok pour l'allègement de la macro j'ai corrigé 2 petites choses et ça tourne par contre j'ai toujours le problème au niveau de la valeur Autre et des valeurs différentes des réf des véhicules que nous connaissons tous

Zorg

 

[zorg]

tiens ça fonctionne avec l'erreur "Autre" mais tjrs pas lorsque la valeur est différente d'un modèle de véhicule

 

[le Fnake]

Re Zorg

lol, pourtant je ne suis pas ton frère, ou alors on me cache des choses

En fait, le pbm a lieu au niveau du test, avec la ligne suivante, ca semble marcher (il y vraisemblablement un problème logique entre les <> et le or, qui pourrait ptet etre remplacé par le and ?) :

ElseIf Not ((Range("A" & Famille).Value = 307) Or (Range("A" & Famille).Value = 406)) Then

pour la valeur "Autre", j'ai pas remarqué de pbm particulier.

bon app

le Fnake

 

[zorg]

Fnake ça commence à pas mal tourner puisque les modeles à chiffres du type 106,206,307... fonctionnent ; manque plus que les utilitairesqui eux ont du texte et pas des chiffres
En tout un grand merci parce qu'en mettant elseif not ça tourne

Zorg

 

[sousou]

Coucou

J'arrive sans doûte après la bataille, mais quelques idées de structure dans ce fichier pour l'avenir de l'appli

 

[le Fnake]

re tout le monde

pour les utilitaires, il suffit d'ajouter
Or (Range("A" & Famille) = "Partner")

par contre, il faut faire attention aux majuscules, "Partner" n'est pas pareil que "partner". Au pire, il est possible de mettre les deux pour etre sur de ne pas en louper
Pour sousou, pas mal ton truc, mais disons que c'est d'un autre niveau. Par contre, il aurait ptet été plus simple d'utiliser, comme tu l'as suggéré d'ailleurs, un select case au lieu d'avoir des "goto" un peu disgracieux et des appels de fonction. Mais la base est là

Bonne soirée

le Fnake

 

[zorg]

Bonjour tout lemonde
Bon, je me reveille que maintenant; j'étais parti sur un autre pb; je viens d'essayer ta dernière soluce Fnake; je sais pas ce que j'ai fait hier soir mais je n'y arrivais pas et là miracle !!! ça marche !!!
ALORS UN GRAND MERCI A VOUS TOUS pour votre coup de main

Zorg

 

[WASSILA]

test d'aptitude avancé en excel 2000,

Bonjour tout le monde,

Je cherche à passer un test d'aptitude avancé en excel 2000, pourriez vous m'aider à trouver un test en line et gratuit, c'est urgent!!!!!!!

merci à tous

wassila

 

[@+Thierry]

Re: test d'aptitude avancé en excel 2000,

Bonjour Wassila, les gens de ce Fil, le Forum

Huum, Huum, "Un Test D'Aptitude Avancé en Excel 2000"........ "On Line et Gratuit"...

Arf... oui oui j'en ai un !

Essaie de répondre au maximum de questions posées sur ce Forum, on va te "monitorer" et "t'encadrer" si tu jamais tu avances des erreurs...

Le meilleur "Banc Test" Gratuit du Net =>

Bon Aprèm
@+Thierry