VBA Excel, tri en fonction de str [Résolu/Fermé]

Signaler
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
-
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
-
Bonjour à tous, je débute en VBA et je bute depuis plus de 2h sur quelque chose qui doit être minime

Sous Excel, je souhaite classer différent objets par famille, par exemple

Une antenne rateau :Antenne
Une parabole: Antenne
Une clé wifi: Antenne
Une lisaison RS232: une liaison
Une lisaison SPI: une liaison
Une Arduino: une carte
Un ATmega: une carte

J'ai commencé avec ce petit bout de code:



Sub RechercheMultiple()
Dim Cible As String

Cible = "Parabole,Rateau,CléWifi"

If InStr(Cible, Range("A1")) = 0 Then
MsgBox "Pas d'Antenne"
Else
Application.Cells(1, 2) = "Antenne"
End If
End Sub



La on est vraiment au cas par cas, mais j'avais un début (et j'étais fier! :p)

J'ai ensuite voulu l'étendre a l'ensemble de mon petit tableau, pour qu'a son lancement, cette macro marque a coté de chaque objet, la famille à la quelle il appartient (Antenne, Liaison ou Carte)

Mais je tourne en rond, dès que j'entreprend une modification pour ne pas etre limiter à ligne par ligne, j'ai des erreurs de type :/

Je débute vraiment en VBA, je suis preneur de tous conseils


Un grand merci

12 réponses

Bonjour,
Avec une petite boucle for et plusieurs critères de recherche :

Sub tri()

Dim I As Variant

For I = 1 To Range("A" & Rows.Count).End(xlUp).Row

If InStr(Cells(I, 1), "Parabole") <> 0 Or InStr(Cells(I, 1), "Rateau") <> 0 Or InStr(Cells(I, 1), "Wifi") <> 0 Then Cells(I, 2) = "Antenne"
Next I
End Sub

Le meme résultat avec la recherche *Like* :

If Cells(I, 1).Value Like "Parabole" Or Cells(I, 1).Value Like "Rateau" Or Cells(I, 1).Value Like "Wifi" Then Cells(I, 2) = "Antenne"

A votre disposition pour d'éventuelles questions
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 65492 internautes nous ont dit merci ce mois-ci

Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
Un énorme merci! je comprend mieux la syntaxe des boucles for du coup!
Je ne trouve pas le VB particulièrement intuitif à l'inverse du C ou du Pyhton mais j'ai l'impression que couplé à Excel il a un potentiel monstrueux

Du coup grâce a ton code en m'en inspirant plus qu’énormément, j'ai pu obtenir ce que je voulais:


Sub tri()

Dim I As Variant

'Antennes'
For I = 1 To Range("A" & Rows.Count).End(xlUp).Row
If InStr(Cells(I, 1), "Parabole") <> 0 Or InStr(Cells(I, 1), "Rateau") <> 0 Or InStr(Cells(I, 1), "Wifi") <> 0 Then Cells(I, 2) = "Antenne"
Next I

'Cartes'
For I = 1 To Range("A" & Rows.Count).End(xlUp).Row
If InStr(Cells(I, 1), "Atmega") <> 0 Or InStr(Cells(I, 1), "Arduino") <> 0 Or InStr(Cells(I, 1), "Polulu") <> 0 Or InStr(Cells(I, 1), "Driver") <> 0 Then Cells(I, 2) = "Carte"
Next I

'Liaisons'
For I = 1 To Range("A" & Rows.Count).End(xlUp).Row
If InStr(Cells(I, 1), "BusCAN") <> 0 Or InStr(Cells(I, 1), "RS232") <> 0 Or InStr(Cells(I, 1), "LI-FI") <> 0 Or InStr(Cells(I, 1), "SPI") <> 0 Or InStr(Cells(I, 1), "I2C") <> 0 Or InStr(Cells(I, 1), "RS512") <> 0 Or InStr(Cells(I, 1), "LI-FI") <> 0 Or InStr(Cells(I, 1), "Bluetooth") <> 0 Or InStr(Cells(I, 1), "Ethernet") <> 0 Then Cells(I, 2) = "Liaison"
Next I


End Sub


Demain j'essayerai de modifier ça pour avoir sur une autre feuille, tous les objets disponibles avec la famille à la quelle ils appartiennent (comme une base de données). Et lorsque que sur une autre feuille sélectionnée, en présence de quelques objets issus de cette base de données mais qui n'ont pas encore été trier, au lancant de la macro, elle ira vérifier cette base de données pour trouver ces même produits déjà triés, et donc leurs donner leurs famille. Je ne sais pas si c'est possible en VB mais c'est la petite idée que j'ai en tête et que je souhaite réaliser

En tout cas encore merci! Et bonne soirée
Content que ça vous ait aidé :-)
Oui c'est faisable, je vous prépare ces quelques lignes et vous me direz si ça vous convient. Je reviens vers vous ce soir ou demain en fin de matinée.
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
Surtout ne vous embêtez pas trop :p Je m'y remet demain matin, je me permettrais de vous montrer mon ébauche de code

En tout cas merci de votre aide, et une bonne soirée à vous


Thomas
Bonjour,
dans une feuille nommée liste matériel remplissez les colonnes A et B avec la base de données (en A les produits et B les familles)

Option Explicit

Sub tri()

Dim I As Variant, J As Variant
Dim cible1 As String, cible2 As String, nomfeuille As String

nomfeuille = ActiveSheet.Name
Range(Cells(1, 2), Cells(Range("A" & Rows.Count).End(xlUp).Row, 2)).ClearContents
Sheets("liste matériel").Activate
For I = 1 To Range("A" & Rows.Count).End(xlUp).Row
cible1 = Cells(I, 1).Value
cible2 = Cells(I, 2).Value
Sheets(nomfeuille).Activate
For J = 1 To Range("A" & Rows.Count).End(xlUp).Row
If Cells(J, 1) <> "" Then
If InStr(Cells(J, 1), cible1) <> 0 And Cells(J, 2) <> "" Then
Cells(J, 1).Select
MsgBox "Attention " & cible1 & " fait déjà partie de la famille " & cible2
End If
If InStr(Cells(J, 1), cible1) <> 0 And Cells(J, 2) = "" Then Cells(J, 2) = cible2
End If
Next J
Sheets("liste matériel").Activate
Next I
Sheets(nomfeuille).Activate

End Sub


J'espère que c'est ce que vous vouliez faire...
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
En fait, j'ai un petit projet à faire, je dois créer une macro pour Excel pour pouvoir traiter les familles d'une multitude de référence d'objets

Le code que vous m'avez fourni fonctionne parfaitement! Je ne connaissais pas l'option Explicit, c'est super, franchement! je vais continuer de peaufiné ça mais je vais énormément avancer aujourd'hui grave à vous

Un énorme merci! je vous payerai bien une bière ou un café (au choix) :p


Cordialement
Content d'avoir pu aider!
Il commence à faire beau donc plus une bière ^^

Non sérieusement c'était avec plaisir et n'hésitez pas si vous avez besoin d'aide pour autre chose (si c'est dans mes compétences évidemment).

Bonne continuation,
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
je viens juste de penser à un petit cas d'erreur, si le produit n'est pas présent ou référencé dans la Base de donnée, puis-je utiliser un Else ou un autre test quelconque pour afficher une MsgBox "Un produit n'est pas présent dans la BDD" ou même pour cibler le produit en question "Ce produit n'est pas présent dans la BDD"

Si ce n'est pas possible t'en pis mais je viens juste d'y penser

En tout cas, grâce à toi j'ai presque fini o/
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
Le probleme de l'objet manquant +1 semble se corriger en faisant:


'Gestion de présence dans la BDD'

For I = 2 To Range("A" & Rows.Count).End(xlUp).Row
If Cells(I, 2) = "" And Cells(I, 1) <> "" Then
Cells(I, 1).Select
MsgBox "ATTENTION un produit n'est pas présent dans la BDD"
End If
Next I
</code

Donc avec I=2 au lieu de I=1, j'ai fais des essais, ça semble marcher mais à confirmer à la longue avec des exemples plus compliqué

Et pour indiquer le produit manquant j'ai fait:

<code>For I = 2 To Range("A" & Rows.Count).End(xlUp).Row
If Cells(I, 2) = "" And Cells(I, 1) <> "" Then
Cells(I, 1).Select
MsgBox "ATTENTION " & cible1 & " n'est pas présent dans la BDD"
End If
Next I


Mais j'ai des décalage de valeur. Imaginons qu'il me manque 3 pièces par rapport a la BDD, il va m'afficher 3 MsgBox mais en ne disant pas le bon nom d'article

J'avance o/
Je viens de regarder et c'est juste des réglages à faire par rapport à ton cas précis :

Pour les alertes résultantes de "MsgBox "Attention " & cible1 & " fait déjà partie de la famille " & cible2" c'est du au test Instr :" nVidia GTX780" est contenu aussi dans "nVidia GTX780Ti".Le problème peut etre réglé de plusieurs manieres : 1- en laissant seulement le plus court des deux dans la BBD (A condition évidemment qu'ils soient de la même famille). 2- en déclarant une autre variable String et en comparant directement leur contenu (implique que la chaîne de caractère soit la même exactement à la lettre près).

ça serrait top s'il disait objet xxx non présent à chaque fois qu'il rencontre un objet qui n'est pas dans la BDD : OK après modif

nombre d'objets manquant +1 : Ok après modif .

Option Explicit

Sub tri()

Dim I As Variant, J As Variant
Dim cible1 As String, cible2 As String, nomfeuille As String, cible3 As String

nomfeuille = ActiveSheet.Name
Range(Cells(2, 2), Cells(Range("A" & Rows.Count).End(xlUp).Row, 2)).ClearContents
'Ref: Famille
Range("A1") = "Ref:"
Range("B1") = "Famille"
Sheets("BDD").Activate
For I = 1 To Range("A" & Rows.Count).End(xlUp).Row
cible1 = Cells(I, 1).Value
cible2 = Cells(I, 2).Value
Sheets(nomfeuille).Activate
For J = 2 To Range("A" & Rows.Count).End(xlUp).Row
If Cells(J, 1) <> "" Then
cible3 = Cells(J, 1).Value
'If InStr(Cells(J, 1), cible1) <> 0 And Cells(J, 2) <> "" Then
If cible1 = cible3 And Cells(J, 2) <> "" Then
Cells(J, 1).Select
MsgBox "Attention " & cible1 & " fait déjà partie de la famille " & cible2
End If
If cible1 = cible3 And Cells(J, 2) = "" Then Cells(J, 2) = cible2
'If InStr(Cells(J, 1), cible1) <> 0 And Cells(J, 2) = "" Then Cells(J, 2) = cible2

End If
Next J
Sheets("BDD").Activate
Next I
Sheets(nomfeuille).Activate
For I = 1 To Range("A" & Rows.Count).End(xlUp).Row
If Cells(I, 2) = "" And Cells(I, 1) <> "" Then
cible1 = Cells(I, 1).Value
Cells(I, 1).Select
MsgBox "ATTENTION " & cible1 & " n'est pas présent dans la BDD"
End If
Next I
End Sub

Teste ça et dis moi si c'est OK
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1 > Stif
Ah ah énorme merci :p
Juste comme ça tu as suivi quoi comme études? Ou alors tu as appris tout seul?

Ce petit projet m'éclate, c'est vraiment marrant de le voir avancer, mais heureusement que t'es la :p

Penses-tu que ce que je t'ai demandé tout à l'heure est réalisable? Je me suis énervé dessus cet après-midi, c'est à dire qu'a l'apparition d'un objet non présent dans le BDD, on puisse choisir ou non de l'ajouter à la BDD? J'ai pas eu l'impression, j'ai juste réussi à effacer des éléments de la BDD au lieu d'en ajouter :3

Encore merci à toi et une bonne soirée
>
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019

Oui oui évidemment c'est faisable je te prépare ça demain matin. un textbox demandera si oui ou non on veut ajouter l'obet, ensuite un imputbox demandera la famille de l'objet qui sera stockée dans une variable string.... Etc etc

J'ai eu mon bac en 2000 et ensuite... J'ai arrêté les études ;)
Je me suis mis au vba ya quelques semaines sur mon temps libre (ça m'aide énormément dans mon nouveau poste) c'est pour ça que ça reste assez basique comparé à certains de ce site (des fous du Codage !!)
Mais bon je progresse à mon rythme et aide quand je peux car c'est grâce à ce forum que j'ai débuté.
Après rien ne vaut la compréhension du langage... En passant un peu de temps à lire on gagne du temps à ne pas bidouiller .
A demain avec les lignes de codes en question
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
Excellent alors :p Je n'en n'avais jamais fait personnellement, je suis plus axé python et C++ j'ai déjà fabriqué quelques petits jeux pour mes études, mais le VBA je n'avais jamais touché mais je trouve ça marrant appliqué a Excel

A demain alors et une bonne soirée à toi
Voilà testes ces quelques lignes / dernière boucle For I à remplacer par :

Sheets(nomfeuille).Activate
For I = 1 To Range("A" & Rows.Count).End(xlUp).Row
If Cells(I, 2) = "" And Cells(I, 1) <> "" Then
cible1 = Cells(I, 1).Value
Cells(I, 1).Select
MsgBox "ATTENTION " & cible1 & " n'est pas présent dans la BDD"
If MsgBox("Voulez-vous rajouter cet objet dans la BBD", vbYesNo, "Demande de confirmation") = vbYes Then
cible2 = InputBox("Quelle est la famille de cet objet?", "Rensignez la famille de cet objet")
Sheets("BDD").Activate

For J = 2 To Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("BDD").Activate
cible3 = Cells(J, 2).Value
If UCase(cible3) <> cible3 Then
cible2 = StrConv(cible2, vbProperCase)
Else: cible2 = UCase(cible2)
End If


If cible2 = cible3 And Cells(J, 2) <> "" Then
Range(Cells(J, 1), Cells(J, 2)).Select
Selection.Copy
Selection.Insert Shift:=xlDown
Cells(J, 1) = cible1
Sheets(nomfeuille).Activate
Exit For
End If
If Cells(J, 1) = "" And Cells(J, 2) = "" Then
cible2 = StrConv(cible2, vbProperCase)
Cells(J, 1) = cible1
Cells(J, 2) = cible2
Sheets(nomfeuille).Activate
Exit For
End If
Next J
End If
End If
Next I
If MsgBox("Voulez-vous relancer l'analyse?", vbYesNo, "Demande de confirmation") = vbYes Then Call tri
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
Je veux bien voir la tête que ça a, si c'est pas trop de taff pour toi

En fait il faut qu'un fichier BDD quelque part puisse etre mit à jour manuellement, et qu'ensuite, lorsque j'ai mon besoin_client.xls seul, en lançant la macro, elle puisse faire son taff sans qu'on lui donne la BDD. Donc je m'étais dis, si on lui indiquant un chemin, genre C:\Users\"BDD.xlsx", la macro aurait pu aller chercher la base de donnée, l'ajouté au classeur ouvert sur le moment, pour permettre la suite des opérations

Désolé je sais que je suis pas méga claire, mais oui c'est la même BDD qu'actuellement sinon
>
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019

http://www.cjoint.com/c/FEFoofqW7UG

Fonctionne à condition que le fichier source n'ait pas de feuille BDD.
Si le fichier est susceptible de contenir une feuille BDD avant le lancement de la macro on peut rajouter quelques lignes pour éviter l'erreur d'exécution de la macro.

Dans la macro Tri_BDD_Famille_Type_Client_couleur remplacer la ligne :
Call Récup_BBD par Call Récup_BBD_auto ou Call Récup_BBD_sans_conf pour essayer les différentes versions.

Dans Sub Récup_BBD_auto() remplacer "C:\Users\8205537M\Desktop\aide Excel\Test\BDD.xlsx" par le chemin du fichier

Une fois les test réalisés la feuille "BDD" est supprimée. Pour la garder il faut enlever la ligne Sheets("BDD").Delete. (mais la attention à l'erreur à la prochaine exécution de la macro)
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
Excuses moi je n'ai pas pu regarder hier soir, je m'y suis remis la, et je pense qu'il manque quelque chose. Il y a bien le "Call Recup_BBD_auto" maais aucune trace du "sub Récup_BBD_auto()"

Merci :p
>
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019

lol ké idiot j'ai up le mauvais fichier! Je bip un nouveau lien
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
Pas de problème t'inquiète! C'est le genre de truc que je pourrais faire aussi :p
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
Re-bonjour, j'aurais une petite question a te poser, j'ai une date dans une colonne de type JJ/MM/AAAA, et dans une colonne je dois mettre que l'année, l'autre que le mois, la troiseme le numero de la semaine

Donc pas de probleme imagine =ANNEE(), =MOIS(), =NO.SEMAINE
Avec l’enregistreur ça marche très bien, mais le probleme c'est que si un jour le fichier ne fait plus 1500 lignes mais 3000, bah les dates n'iront pas jusqu'au bout. Donc je me demandais avec programmation, comment faire un peu comme pour les tri, générer les dates en fonction de la colonne JJ/MM/AAAA pour qu'il y ait toujours le bon nombre de données. J'ai essayé mais ça merdouille

1) En A il faut convertir la date en jj.mm.aaaa en date, donc onglet convertir et pas de probleme, mais je me demande si un jour j'ai un tableau énorme est-ce qu'il y aura conversion jusqu'au bout

2) En B sortir l'année de cette date (la c'est sur qu'en cas de grand tableau, à cause de enregistreur ça pose un gros pb)

3) En C le mois (idem)

4) En D le n°semaine (idem)

Je voudrais que 2-3-4 soient fait en fonction de A comme pour le tri, et pas sur une plage fixe à cause de l’enregistreur

Tu verras j'ai fais un petit exemple ou comme des données ne sont pas en A, il y à une plage d'erreur

https://drive.google.com/open?id=0ByykuPoanvBmOXF3eDlQMXhFWVE

Merci beaucoup! :p
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
Résolu! J'ai créé une variable derniereLigne qui prend comme référence la colonne précédente, pour que la taille s'adapte toujours

Voila le résultat:


Sub DateMacro()


Dim DernLigne As Long

DernLigne = Range("A" & Rows.Count).End(xlUp).Row



Columns("A:A").Select
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True
Selection.NumberFormat = "dd/mm/yy;@"
Range("B2").Select
ActiveCell.FormulaR1C1 = "=YEAR(RC[-1])"
Range("C2").Select
ActiveCell.FormulaR1C1 = "=MONTH(RC[-2])"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=WEEKNUM(RC[-3])"
Range("D3").Select

Range("B2").AutoFill Destination:=Range("B2:B" & DernLigne)
Range("C2").AutoFill Destination:=Range("C2:C" & DernLigne)
Range("D2").AutoFill Destination:=Range("D2:D" & DernLigne)


End Sub
Désolé l'ami soucis perso... De retour lundi je te bip les macros et regarde les derniers messages
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
Je n'osais pas te demander si ça aller mieux, nickel si ça roule maintenant :p

La dernière modification éventuelle que je n'ai pas encore fait, (ni essayé), c'est une dernière macro indépendante qui s’appellerait "Sauvegarde_BDD" par exemple, qui justement après que le fichier a été traité, et la base de donnée mise à jour avec les inconnus éventuels, sauvegarde uniquement la BDD, (que la feuille BDD.xls ou .xlsx)

Parce que dans l'état actuel des choses, il faut re-séparer besoin_client et la BDD pour save que la BDD

Ce qui faciliterait grandement la MàJ :3

Mais grâce à toi et tes indications dès le début, j'ai pu carrément beaucoup avancer dans mon coin, j'ai choppé le truc, et pour ça vraiment merci!
>
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019

Si tu veux sauvegarder la bbd automatiquement avant qu'elle se referme il faut modifier la ligne : Windows(Nom2).Close False par Windows(Nom2).Close True.

Si tu veux demander une confirmation de sauvegarde on peut essayer ça :

If MsgBox("Voulez-vous sauvegarder la BBD avant fermeture?", vbYesNo, "Demande de confirmation") = vbYes Then
Windows(Nom2).Close True

Else: Windows(Nom2).Close False
End If

Si c'est pas ça que tu voulais redis moi et je bricole un truc ;)
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
Je testerais pour voir mais merci! :p

sinon j'ai fais ça dans mon coin aujourd’hui, et ça fait le taff, mais c'est peut-être plus lourd


Sub Enregistrement_BDD()

Dim ChDir As String
Dim NomFichier As String
Dim NomCompletFichier As String

Sheets("BDD").Select

'ChDir = Application.ActiveWorkbook.Path 'Chemin courant
ChDir = "K:\Systeme_D-info\PIC\archive\Macro TJ\2) - Base De Données"


NomFichier = "BDD"
'Ligne définitive :
'NomCompletFichier = ChDir & "\" & NomFichier

'Ajout de l'heure au nom de fichier
'Dim stHeureExport As String
'stHeureExport = "_" & _
' Format(Hour(Time), "00") & "." & Format(Minute(Time), "00") & "." & _
' Format(Second(Time), "00")
NomCompletFichier = ChDir & "\" & NomFichier & ".xlsx" '& stHeureExport

'Copie feuille courante dans nouveau classeur et enregistrement
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=NomCompletFichier
ActiveWorkbook.Close

MsgBox "le fichier a été enregistré sous le nom : " & vbCrLf & NomCompletFichier



End Sub
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
Salut, j'ai un problème bizarre

Si j'utilise la macro pour importer le besoin_client et la BDD, pas de problème, la macro fait son taf, sauf que les nouveaux objets inconnus ne sont pas détectés. Il dit toujours 0 inconnus. Alors que si j'ajoute le besoin_client directement au classeur, sans passé par la macro pour l'importation, la pas de problème, les inconnus seront bien détectés

Peut-on essayé un autre méthode pour l'importation? Par exemple au lieu de "copier" le besoin_client, carrément l'importer en dur?

Désolé je ne pense pas être très claire :p Merci
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1 >
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019

Résolu, c'est peut-etre plus bourrin mais ça marche:


'import besoin_client'
MsgBox "Veuillez séléctionner le fichier 'besoin_client'"

ChDrive "K:" ' Choix du lecteur
ChDir "K:\Systeme_D-info\PIC\archive\Macro TJ\1) - besoin_client"

QuelFichier = Application.GetOpenFilename()
If QuelFichier <> False Then
Else
MsgBox "Vous n'avez pas sélectionné de fichier"
End If

Workbooks.Open Filename:= _
QuelFichier
Sheets("besoin_client").Move After:=Workbooks("Menu.xlsm").Sheets(1)


Le problème venait bien du fait que le fichier était copié, trop bizarre...
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
J'ai une nouvelle colle si ça intéresse :p

Chaque produit est associé une date, elle peut-être passée/aujourd'hui/futur

En cas de date passé, pour tout les articles, il faut que la date des articles passé soit mise à la date du dernier jours du mois précédent

Par exemple aujourd'hui 14/06/2016
Tout les articles <14/06/2016 doivent prendre la date du 31/05/2016

Demain idem, les articles du 14/06/2016 -> 31/05/2016

Ce qui implique, une fonction d'excel qui donne surement à une variable le jour d'aujourd'hui. Et surement un petit test qui regarde si la date des articles est inférieur ou égale à la valeur de cette variable

je vais m'y mettre, si tu trouves avant moi tiens moi au jus :p

Un grand merci
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1 > Stif
C'est ça, tes lignes sont exactement ce dont j'ai besoin, mais je n'arrive pas à l'appliquer à une colonne complète :/ En l’occurrence elles seront dans la colonne H

Mais ça m'agace j'ai tenté plusieurs boucles FOR sans succès :/

Un grand merci l'ami
>
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019

Ca devrait le faire :

Dim dernierjour As Date
Dim I As Variant

For I = 2 To Range("H" & Rows.Count).End(xlUp).Row

If (Cells(I, 8)) <> "" Then
dernierjour = DateAdd("d", -1, CDate("1/" & Format(Date, "mm/yyyy")))
If Month(Cells(I, 8)) < Month(Date) And Year(Cells(I, 8)) = Year(Date) Then Cells(I, 8) = dernierjour
If Year(Cells(I, 8)) < Year(Date) Then Cells(I, 8) = dernierjour
End If
Next I

EDIT : If (Cells(I, 8)) <> "" Then pas If (Range("A6)) <> "" Then
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
Comme d'habitude bien joué! Merci!

Un bonne soirée à toi!
>
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019

De rien :)
Si besoin hésites pas surtout.

Bonne soirée
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1 > Stif
Ça marche, mais j'aime bien essayé de me dépatouiller un peu dans mon coin avant de te solliciter, ça se fait pas sinon :p

A bientot :3
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
Si tu es toujours d'attaque, j'ai un morceau encore plus gros :p
Yes avec plaisir l'ami
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
Mais la honnêtement c'est un sacré morceau :p J'ai terminé toute ma partie grâce à toi, mais du coup quelqu'un d'un autre service m'a demandé si je pouvais faire un truc pour lui

J'ai regardé et je suis lui ai carrément dit que c'était hardcore :p Mais il me reste une semaine après je suis liiiiiiiiiiiiiiiiiiiiiiiiiibre (je ne chanterais pas :3)

En fait, tout les jours il a une liste, avec les retards d'envois ou le bon respect de délai de différentes commandes client, et tous les jours, qu'elles soient en retards ou non, il doit envoyé l'état de ces commandes aux clients

Mais, j'ai déjà une macro qui permet d'envoyer a chaques clients en cochant leurs noms, un mail de rappel, (j'ai déjà la feuille avec les noms et les mails correspondants, ainsi que la feuille à cocher pour l'envois, et la macro qui fait ce mail de rappel, le tout fonctionnel)

Il faudrait donc l'adapté à la fiche d'état des commandes, pour scinder cette feuille et envoyer l'état des commandes aux bon clients correspondants et non à tout le monde la même feuille

J'ai conscience que c'est pas super claire :p Et que ça va être plus compliqué, je récupère ce que j'ai déjà fait et qui fonctionne lundi je te l'enverrais, ça sera plus claire

En tout cas un bon weekend à toi et merci de ta bonne volonté

Thomas
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
Voila les fichiers, il y a un début qui s'appliquait à un autre fichier, mais j'aurais besoin qu'en cochant les cases correspondantes dans le fichier "relance", la macro envoie par mail l'état du fichier OTD aux client des lignes correspondantes, par exemple si on coche client1 et client3, client1 recevra les lignes correspondante au client1 du fichier OTD, et idem client3

les adresses mails et les noms serront dans le fichier _Fournisseurs_

Merci de ton aide, je t'avoue que je me casse vraiment les dents dessus :/

J'aurais pas du devoir le faire mais comme j'ai fini ma partie ils m'ont demandé de regarder :p

Un grand merci l'ami!
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
Je voudrais que la totalité des "clients" présent dans _Fournisseurs_ soient automatiquement mit dans la colonne B du fichier Relance

Mais au pire c'est vraiment rien, j'avais commencé dans le fichier que je t'ai partagé, mais les macros morlfent un peu :p
>
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019

classeur1 = ActiveWorkbook.Name à déplacer sous la ligne Dim testclient As Integer

Ensuite :
Workbooks.Open ("C:\Users\8205537M\Desktop\aide Excel\Test\mail\_Fournisseurs_.xlsx")
classeur2 = ActiveWorkbook.Name
Windows(classeur2).Activate
Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Copy
Windows(classeur1).Activate
Range("B2").PasteSpecial
Windows(classeur2).Close False
Windows(classeur1).Activate

a mettre avant Application.ScreenUpdating = False

Edit : Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row).ClearContents à rajouter aussi sous la ligne Dim testclient As Integer
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
Re désolé j'ai été fort occupé hier soir, merci pour le chargements des adresses

J'ai bidouillé un peu de mon coté, le fichier de base tel que tu me l'a donné marche nickel, et en fait, c'est quand on fait le systeme pour pouvoir sélectionner le fichier OTD qu'il plante. L'erreur " il m'ouvre la Sub mail(), et il me dit Erreur de Compilation, nom ambigu détecté: mailclient" apparait seulement, si j'ajoute des nouveaux clients dans le fichier de relance

alors que de base, sans cette fonctionnalité elle marche top


Edit: tu vas rigoler, j'ai trouver la solution, mais ça n'a aucune logique

la macro 'mail' et la macro 'relance' étaient dans deux fichier différents, j'ai copié 'mail' à la suite de 'relance', donc dans le même fichier et la ça tourne parfaitement, que ça soit la version de base ou la plus poussé avec sélection de l'OTD

Sans de bons gros mystères comme ceux-la ça perdrait tout son charme :p
>
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019

Ah je pense que c'est normal si les macros n'étaient pas dans le même classeur...
Après il doit y avoir moyen d'appeler la macro d'un autre classeur mais certainement après l'ouverture préalable de ce dernier...

Le principal est que ça fonctionne comme tu le voulais!

Besoin d'autre chose?
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
La c'est nickel nickel, je suis en phase de test depuis ce matin, pour l'instant ça roule :p

Tu penses que ça serrais sympa d'afficher un message du genre email 1/412 envoyé, puis 2/412 etc? Ou ça serrait lourd niveau temps et ressources? Je me tâte

En tout cas, tout est terminé définitivement! Grace à toi! Sincèrement merci de ton aide et ton investissement
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1
Ah non il reste un problème, mais c'est peut-etre moi qui est mal intégré ton code regarde:


Public classeur2 As String
Public classeur3 As String
Public mailclient As String
Public lignesenretard As Integer
Public OTDcible As String
Public nomODTcible As String

Option Explicit




Sub Envoi_OTD()
Dim a As Variant, b As Variant
Dim classeur1 As String
Dim I As Variant, J As Variant
Dim clienta As String, clientb As String
Dim testclient As Integer
testclient = 2

MsgBox ("Séléctionner le fichier OTD:")
ChDrive "K:" ' Choix du lecteur
ChDir "K:\Systeme_D-info\PIC\archive\Macro TJ\Mail OTD" 'Choix du répertoire
a = Application.GetOpenFilename("fichier excel (*.xlsx), *.xlsx", _
, "Quel sera le PJ à renseigner ?", , True)

Select Case TypeName(a)
Case Is = "Boolean"
Exit Sub
Case Else
For b = LBound(a) To UBound(a)
Workbooks.Open a(b)
Next
End Select
nomODTcible = ActiveWorkbook.Name
OTDcible = ActiveWorkbook.FullName
Windows(nomODTcible).Close False

classeur1 = ActiveWorkbook.Name
Application.ScreenUpdating = False

For I = 2 To Range("B" & Rows.Count).End(xlUp).Row
If Cells(I, 1) <> "" Then
'clienta = Cells(I, 2)
clienta = StrConv(Cells(I, 2).Value, vbProperCase)
'Cells(I, 2) = StrConv(Cells(I, 2).Value, vbProperCase)
'clienta = Cells(I, 2).Value
Workbooks.Open ("K:\Systeme_D-info\PIC\archive\Macro TJ\Mail OTD\OTD.xlsx")
classeur2 = ActiveWorkbook.Name
Windows(classeur2).Activate
ChDir "K:\Systeme_D-info\PIC\archive\Macro TJ\Mail OTD"
ActiveWorkbook.SaveAs Filename:="OTD_" & clienta & classeur2
classeur2 = ActiveWorkbook.Name
Windows(classeur2).Activate
Do While Cells(testclient, 2) <> ""
If Cells(testclient, 2) = "" Then Exit Do
If clienta <> StrConv(Cells(testclient, 2), vbProperCase) Then Cells(testclient, 2).EntireRow.Delete
If clienta = StrConv(Cells(testclient, 2), vbProperCase) Then testclient = testclient + 1
Loop
'lignesenretard
For J = 2 To Range("B" & Rows.Count).End(xlUp).Row
If Cells(J, 20) = "" And Cells(J, 2) <> "" Then lignesenretard = lignesenretard + 1
Next J


Columns("T:T").Select
Selection.TextToColumns Destination:=Range("T1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True

Dim DernLigne As Long
DernLigne = Range("A" & Rows.Count).End(xlUp).Row

Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

'Nb de lignes
Range("M1").Select
ActiveCell.FormulaR1C1 = "Nb de lignes:"
Range("N1").Select
ActiveCell.FormulaR1C1 = (DernLigne - 1)

'Nb cellule non vides
Range("P1").Select
ActiveCell.FormulaR1C1 = "Lignes non vides:"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "=COUNTA(R[2]C[3]:R[199]C[3])"

Range("S1").Select
ActiveCell.FormulaR1C1 = "OTD:"

'Cellule non vides/Nb de ligne
Range("T1").Select
ActiveCell.FormulaR1C1 = "=RC[-3]/RC[-6]"


Range("A1").Select
Windows(classeur2).Close True


Workbooks.Open ("K:\Systeme_D-info\PIC\archive\Macro TJ\Mail OTD\Fournisseurs\_Fournisseurs_.xls")
classeur3 = ActiveWorkbook.Name
Windows(classeur3).Activate
For J = 2 To Range("A" & Rows.Count).End(xlUp).Row
If clienta = StrConv(Cells(J, 1), vbProperCase) Then
If Cells(J, 2) = "" Then
MsgBox "ATTENTION aucun Email Fournisseur n'est renseigné pour le client" & clienta
ChDir "K:\Systeme_D-info\PIC\archive\Macro TJ\Mail OTD"
Kill classeur2
Exit Sub
Else:
mailclient = Cells(J, 2).Value
Call mail
ChDir "K:\Systeme_D-info\PIC\archive\Macro TJ\Mail OTD"
Kill classeur2
End If
End If

Next J
Windows(classeur3).Close False
End If

lignesenretard = 0
testclient = 2
Windows(classeur1).Activate

Next I


MsgBox ("Mail(s) envoyé(s)")


Application.ScreenUpdating = True
End Sub

Sub mail()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim olFormatHTML As String






Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = mailclient
.Subject = "OTD"
.Body = "Veuillez trouver ci-joint le fichier ODT" & vbCrLf & vbCrLf & "Cordialement"
.Attachments.Add "K:\Systeme_D-info\PIC\archive\Macro TJ\Mail OTD\" & classeur2
.Send
End With
Set OutApp = Nothing
End Sub



Il reste ce morceau "Workbooks.Open ("K:\Systeme_D-info\PIC\archive\Macro TJ\Mail OTD\OTD.xlsx")" qui fait que le fichier ne lit pas en fait l'OTD qu'on lui a donné, mais toujours celui par défaut
oui remplace la ligne Workbooks.Open ("K:\Systeme_D-info\PIC\archive\Macro TJ\Mail OTD\OTD.xlsx" par Workbooks.Open OTDcible et ca devrait fonctionner
Messages postés
122
Date d'inscription
mardi 29 décembre 2009
Statut
Membre
Dernière intervention
4 mars 2019
1 > Stif
Nickel nickel! Un grand merci et bonne fin d'après-midi

Thomas