Test sur Chaines Excel [Fermé]

Signaler
Messages postés
24
Date d'inscription
mardi 1 novembre 2016
Statut
Membre
Dernière intervention
15 novembre 2016
-
Messages postés
24
Date d'inscription
mardi 1 novembre 2016
Statut
Membre
Dernière intervention
15 novembre 2016
-
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

1 réponse

Messages postés
24
Date d'inscription
mardi 1 novembre 2016
Statut
Membre
Dernière intervention
15 novembre 2016

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