SakiManiac
Messages postés24Date d'inscriptionmardi 1 novembre 2016StatutMembreDernière intervention15 novembre 2016
-
9 nov. 2016 à 11:05
SakiManiac
Messages postés24Date d'inscriptionmardi 1 novembre 2016StatutMembreDernière intervention15 novembre 2016
-
9 nov. 2016 à 12:48
Bonjour,
J'ai une base de donnée Excel qui contient des emails sur les quels je fais un test (Si l'adresse contient un prénom / nom figurant sur la base de données elle lui attribue ses derniers et son sexe sur la feuille, Merci à Whismeril)
Donc au fur et à mésur je modifie le code selon le besoin, quand l'email ne contient pas un prénom/nom valable elle lui attribue "name" + un nombre. Ce dont j'ai besoin maintenant : Parfois on modifie la case prénom / nom manuellement s'il est impossible de le retrouver avec l'email, mais quand je relance le macro elle remets tout ceux qu'on a modifié manuellement en "namexx". Je ne suis pas fort en VB, j'ai essayé de rajouter une fonction Boolean qui test si le Prenom contient "name" mais elle me remet tout ceux qui contiennent name en cellule vide et ne garde pas la valeur précedente (Que j'ai re modifier pour mettre à la place "rien" parcequ'il y a une erreur de code quand la cellule est vide)
Merci d'avance
PS : Un exemple en Excel
Sub Macro1() Dim lesGarcons() As String lesGarcons = TableauDeDonnees("Feuil2", "A")
Dim lesFilles() As String lesFilles = TableauDeDonnees("Feuil3", "A")
Dim nomfamille() As String nomfamille = TableauDeDonnees("Feuil4", "A")
Dim lesAdresses() As String lesAdresses = TableauDeDonnees("Feuil1", "E")
Dim ListeP() As String ListeP = TableauDeDonnees("Feuil1", "C")
For i = LBound(lesAdresses) To UBound(lesAdresses) Dim Prenom As String Dim sexe As String Dim neut As String Dim test As String
Dim nomfamille1 As Boolean Dim nom As String nomfamille1 = CompareAdresseEtTableau(nomfamille, lesAdresses(i), nom)
Dim garcon As Boolean Dim prenomGarcon As String garcon = CompareAdresseEtTableau(lesGarcons, lesAdresses(i), prenomGarcon)
Dim fille As Boolean Dim prenomFille As String fille = CompareAdresseEtTableau(lesFilles, lesAdresses(i), prenomFille)
Dim TestNameH As Boolean Dim nameh As String TestName = Comparer(ListeP, ListeP(i), nameh)
If Not nomfamille1 Then nom = "name" + test End If If fille And garcon Then Prenom = prenomFille sexe = "Mlle"
ElseIf garcon Then sexe = "Mr" Prenom = prenomGarcon
ElseIf fille Then sexe = "Mlle" Prenom = prenomFille
ElseIf Not garcon And Not fille Then 'If TestNameH Then sexe = "N" test = CStr(i) Prenom = "name" + test 'Else 'sexe = "N" 'Prenom = nameh 'End If
End If
'If garcon Or fille Then 'si un résultat a été trouvé on l'affiche With Worksheets("Feuil1") .Range("F" & i + 2).Value = sexe .Range("D" & i + 2).Value = nom .Range("C" & i + 2).Value = Prenom End With 'End If
Next i
End Sub
Function TableauDeDonnees(NomFeuille As String, Colonne As String) As String() With Worksheets(NomFeuille) Dim donnees As Variant Dim dernierLigne As Long
dernierLigne = .Range(Colonne & Rows.Count).End(xlUp).Row 'dernière ligne non vide
Dim leRange As String leRange = Colonne & "2:" & Colonne & dernierLigne donnees = .Range(leRange).Value 'toutes les données de la plage A2-> ADerniereLigneNonVide
Dim tailleTableau As Integer Dim Resultat() As String ReDim Resultat(dernierLigne - 2)
For i = 1 To UBound(donnees, 1) 'Extraction des données sous forme d'un tableau de string Resultat(i - 1) = donnees(i, 1) Next i
TableauDeDonnees = Resultat End With End Function
Function CompareAdresseEtTableau(TableauDePrenoms() As String, Adresse As String, ByRef PrenomTrouve) As Boolean 'comparaison avec l'opérateur Like For i = LBound(TableauDePrenoms) To UBound(TableauDePrenoms)
If Adresse Like "*" & TableauDePrenoms(i) & "*@*.*" Then 'si l'adresse correspond à un prénom, on affecte le resulat CompareAdresseEtTableau = True PrenomTrouve = TableauDePrenoms(i) Exit Function End If Next i
'si aucun prenom trouvé CompareAdresseEtTableau = False PrenomTrouve = "N"
End Function
Function Comparer(name() As String, Prenom As String, ByRef Resultat) As Boolean For i = LBound(name) To UBound(name)
If Prenom Like "name" Then Comparer = True Resultat = "rien" Exit Function End If Next i End Function
SakiManiac
Messages postés24Date d'inscriptionmardi 1 novembre 2016StatutMembreDernière intervention15 novembre 2016 9 nov. 2016 à 12:48
Il y a aussi quelque chose que je souhaite améliorer : Si l'email contient deux prénom(Male/Femelle) je veux choisir celui avec la chaîne de caractère la plus longue