Problem ct faire une base de recherche sur Excel

Bonjour à tous,

je voudrais creer une base de recherhce sur Excel a partir d 'une liste sur deux feuilles

et dans ma 3éme feuille creer une base de recherche

sous la forme:

NOM Homme DUPONT

et il me donne la liste des DUPONT

DUPONT Jean

DUPONT Marie

DUPONT Patrick

Merci d'avance pour votre aide

je joint une partie de mon fichier car il est trop gros j ai ma premierer feuille pleine dans le cas ou quelqu'un puisse m aider

Ludovic

Bonjour et bienvenue,

Pourquoi as-tu 2 bases ?

Voici un exemple simple, si tu veux, on peut l'adapté à tons cas

Amicalement

Claude.

MERCI CLAUDE

je veux bien t envoyer ma basse mais elle fait 15 MO voici mon mail si je peux te l envoyer envoi moi un mail

Ludovicacte2@hotmail.fr

sa m'aiderai beaucup car je ne connais que les basses d excel

pour t expliquer

je fais des recherche genealogique

j'ai fait une liste de mariage sous la forme

NOMHOMME PrH NOMF PrF Date Lieu dep

au debut sa aller mais maintenant j ai deux feuille car je depasse les lignes d excel

mon but et de pouvoir faire une recherche

du style chercher tous les DUPONT homme

ou tous les DELATTRE femme

a l'ecole je me souviens que l on pouvais faire une liste

nom prenom adresse

et sur une autre page ou taper le nom et sa nous lister tous les nom idem

SI tu peux m aider je t en remersirer d'avance

Un grand merci pour tous ceux qui pourrons m aider

Ludovic

re,

J'ai très bien compris ce que tu veux faire,

Ce n'est jamais qu'une base de données avec critères de recherche.

Je te conseil d'attendre un peu, le temps d'investir en passant à Excel 2007,

au lieu des 65536 lignes, tu auras + de 1 400 000 lignes.

et donc une seule base, beaucoup + facile à gérer.

Qu'en pense-tu ?

Claude.

A BON JE NE SAVAIS PAS JE T EN REMERCI CAR J AI EUT UN NOUVEAU PC POUR NOEL EST IL Y A EXCEL 2007 DECU

MAIS J AI PAS ENCORE REGARDER

MERCI POUR L INFO

TU ME SAUVE LA VIE

Ludovic

Bonne journée a tous

Bonjour,

J'ai développé à partir du fichier que vous avez fourni aussi est-il impératif d'en conserver la structure.

Code à copier dans un module standard

'### Constantes à adapter ###
Const BD1 As String = "Base de données 1"
Const BD2 As String = "Base de données 2"
Const FEUILLE_RECHERCHE As String = "Recherche"
Const CELL_HOMME As String = "a5"
Const CELL_FEMME As String = "c5"
'############################

Sub RechercheNom()
Dim S As Worksheet
Dim R As Range
Dim A$
Dim Homme$
Dim Femme$
Dim var1
Dim var2
Dim T()
Dim T2()
Dim i&
Dim j&
Dim cpt&
'--- Vérification de la cohérence ---
On Error GoTo Erreur
A$ = BD1
Set S = Sheets(A$)
A$ = BD2
Set S = Sheets(A$)
A$ = FEUILLE_RECHERCHE
Set S = Sheets(A$)
On Error GoTo 0
If Trim(S.Range(CELL_HOMME)) = "" And Trim(S.Range(CELL_FEMME)) = "" Then
  MsgBox "Ni le nom de l'homme ni le nom de la femme ne sont renseignés dans la feuille ''" & A$ & "''"
  Exit Sub
End If
'--- Mise en tableau VBA des listes ---
Homme$ = UCase(Trim(S.Range(CELL_HOMME)))
Femme$ = UCase(Trim(S.Range(CELL_FEMME)))
Set S = Sheets(BD1)
If S.[a65536] <> "" Then
  Set R = S.Range("a2:h65536")
Else
  Set R = S.Range("a2:h" & S.[a65536].End(xlUp).Row & "")
End If
var1 = R
Set S = Sheets(BD2)
If S.[a65536] <> "" Then
  Set R = S.Range("a2:h65536")
Else
  Set R = S.Range("a2:h" & S.[a65536].End(xlUp).Row & "")
End If
var2 = R
ReDim T(1 To UBound(var1, 1) + UBound(var2, 1), 1 To UBound(var1, 2))
For i& = 1 To UBound(T, 1)
  cpt& = cpt& + 1
  If cpt& <= UBound(var1, 1) Then
    For j& = 1 To UBound(T, 2)
      T(i&, j&) = var1(cpt&, j&)
    Next j&
  Else
    For j& = 1 To UBound(T, 2)
      T(i&, j&) = var2(cpt& - UBound(var1, 1), j&)
    Next j&
  End If
Next i&
'--- Recherche dans le tableau VBA ---
cpt& = 0
If Homme$ <> "" And Femme$ <> "" Then
  For i& = 1 To UBound(T, 1)
    If Homme$ = UCase(Trim(T(i&, 1))) And _
        Femme$ = UCase(Trim(T(i&, 3))) Then
      cpt& = cpt& + 1
      ReDim Preserve T2(1 To UBound(T, 2), 1 To cpt&)
      For j& = 1 To UBound(T, 2)
        T2(j&, cpt&) = T(i&, j&)
      Next j&
    End If
  Next i&
ElseIf Homme$ <> "" And Femme$ = "" Then
  For i& = 1 To UBound(T, 1)
    If Homme$ = UCase(Trim(T(i&, 1))) Then
      cpt& = cpt& + 1
      ReDim Preserve T2(1 To UBound(T, 2), 1 To cpt&)
      For j& = 1 To UBound(T, 2)
        T2(j&, cpt&) = T(i&, j&)
      Next j&
    End If
  Next i&
ElseIf Homme$ = "" And Femme$ <> "" Then
  For i& = 1 To UBound(T, 1)
    If Femme$ = UCase(Trim(T(i&, 3))) Then
      cpt& = cpt& + 1
      ReDim Preserve T2(1 To UBound(T, 2), 1 To cpt&)
      For j& = 1 To UBound(T, 2)
        T2(j&, cpt&) = T(i&, j&)
      Next j&
    End If
  Next i&
End If
If cpt& = 0 Then
  MsgBox "La recherche n'a donné aucun résultat."
  Exit Sub
End If
'--- Inscription du résultat dans une nouvelle feuille ---
Set S = Sheets.Add(after:=Sheets(Sheets.Count))
Set R = S.Range("a1:h" & UBound(T2, 2) & "")
R = WorksheetFunction.Transpose(T2)
Exit Sub
Erreur:
MsgBox "La feuille ''" & A$ & "'' est introuvable."
End Sub

Dans la feuille "Recherche" renseignez les cellules A5 et/ou C5 puis lancez la macro RechercheNom.

Si des résultats sont trouvés, ceux-ci s'inscrivent dans une nouvelle feuille.

Avec la base restreinte dont je dispose, le traitement est très rapide.

Qu'en est-il avec votre base complète ? Merci de me le faire savoir.

Cordialement.

PMO

Patrick Morange

Bonsoir,

Rien n'est + rapide que les filtres élaborés !

L'inconvénient dans ton code (entre autres), c'est qu'il faille orthographier exactement le nom,

de plus, si tu demande 2 critères, l'un peut contrarier l'autre et la recherche échoue.

Fais un test sur ce fichier en y mettant tes 2 bases réunies à la suite.

J'utilise le filtrage en deux temps.

Amicalement

Claude.

édit: retire le "résolu" si tu veux continuer le fil

32ludo-base-2.xlsm (29.23 Ko)
screen
dubois a écrit :

Bonsoir,

Rien n'est + rapide que les filtres élaborés !

L'inconvénient dans ton code (entre autres), c'est qu'il faille orthographier exactement le nom,

de plus, si tu demande 2 critères, l'un peut contrarier l'autre et la recherche échoue.

Fais un test sur ce fichier en y mettant tes 2 bases réunies à la suite.

J'utilise le filtrage en deux temps.

Amicalement

Claude.

édit: retire le "résolu" si tu veux continuer le fil

Pour Patrick Morange * merci bien de ton aide mais j ai pas trop comprit

pour Claude * Un grand merci c'est exactement ce que je voulais, tu es vraiment super sympa parcontre sans vouloir abuser et si un jour je depase mes lignes, la méthode trouvé n 'est plus valable ou est possible sur deux feuilles ?

sinon s'est déjà un grand pas pour moi UN GRAND MERCI

Ludovic

Bonsoir Ludovic, forum,

Si un jour je dépasse mes lignes, la méthode trouvé n 'est plus valable ou est possible sur deux feuilles ?

non c'est prévu pour une seule feuille !

dans le code "Initialise" remplace cette ligne:

Lg = Range("A300000").End(xlUp).Row

par celle-ci:

Lg = Range("A1048576").End(xlUp).Row

maintenant, je ne sais pas ce que çà donne avec 1 million de lignes ?, combien pèsera le fichier ? (en Mo)

çà risque de ramer !

Tu pourrais envisager de scinder les données en triant par années,

et de faire plusieurs fichiers, par exemple "de 1600 à 1700", "de 1700 à 1800", etc... faut voir !

Claude.

un grand merci claude

je pense faire ce que tu m as dit faire une division par année quand mon fichier sera trop important

sinon a titre d'information quand je suis passer de excel 2003 à 2008 mon fichier est passer de 30 mo a 8 mo c bizarre est il ne me manque rien idem

Bonne Fête à Claude et tous ceux du forum

Ludovic

-- 31 Déc 2009, 11:29 --

uN PETIT SOUCIS Claude j ai changé la formule mais sa marche pas

sa m effacer mes donnée dans la deusieme page et sa me met les données rechercher a la place

cordialement ludovic

Salut Ludo, forum,

quand je suis passer de excel 2003 à 2008 mon fichier est passer de 30 mo a 8 mo

C'est normal, je crois savoir que les fichiers en .xlsm sont compressés d'office (info sans garantie !)

Pour ma culture perso.

  • combien de lignes sur ton fichier actuel ?
  • comment se comportent les filtres ? , çà rame ?
Bonne Année

Claude.

environ 200 000 ligne pour l instant sa rame pas du tous

nikel ta formule

re,

J'avais pas vu ton édit

uN PETIT SOUCIS Claude j ai changé la formule mais sa marche pas

sa m effacer mes donnée dans la deusieme page et sa me met les données rechercher a la place

C'est normal, le programme est prévu pour çà,

Que voulais-tu ?

développe ton idée

Claude.

Salut claude

ta methode est tres bien

mais un jour ou l autre j'arriverai en fin de feuille

j'ai fait le changement que tu ma dit j'ai prolonger ma table en fessant un copie coller comme si j avais termine la feuille

et la sa ne marche plus

- et si je met des listes dans la seconde feuille

au momment d'une recherche sa me l efface

ludo

Relis bien l'encadré explicatif,

après avoir fais le copier/coller, as-tu bien cliquer le bouton "Initialise" ?

- et si je met des listes dans la seconde feuille au momment d'une recherche sa me l efface

si tu veux parler de la feuille "Extrait", il ne faut rien entrer dedans, c'est une feuille dynamique qui affiche les

résultats de la recherche.

Quand ton fichier sera plein, c'est à dire 1 million de lignes, tu devras faire un nouveau fichier (nouveau nom)

mais pas ajouter de feuilles.

---------------- Ce que je ferais (à ta place) -------------

1) tri des 200 000 lignes par années

2) voir l'année à la moitié (100 000 ème ligne environ) et scinder le fichier en deux ici en faisant un repère.

3) Enregistrer comme çà.

4) faire un "Enregistrer-sous" (autre nom) et supprimer à partir du repère les dernières lignes, Enregistrer.

5) revenir au 1er fichier et supprimer jusqu'au repère les 1ères lignes, Enregistrer.

Là, tu as donc 2 fichiers de 100 000 lignes chacun, les renommer "de 1600 à 1738" par exemple,

sur chaque fichier, tu clique le bouton "Initialise", tout devrait fonctionner.

Pour les nouvelles lignes, tu choisi le fichier qui va bien suivant la date,

il te reste 900 000 lignes sur chaque fichier, çà ira !!!

pigé ?

Claude.

OK MERCI BONNE ANNEE 2010

LUDO

screen
Rechercher des sujets similaires à "problem base recherche"