Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
XL 2016Lire dans classeurs fermés et copie si trouve
Me voici devant un nouveau souci de codification que je ne sais vraiment pas faire.
Malgré mes recherches j'ai pas trouvé de solution sur le site et sur le net.
J'ai tenté beaucoup de codes que j'ai tenté d'adapter sans succès.
Je ne tourne "naturellement" LOL vers nos ténors toujours si efficaces pour solliciter de l'aide.
Voici mon problème :
ici, pour l'exemple, j'ai créé 3 classeurs (si solution il y a, il me sera facile de modifier pour inclure tous les classeurs dans le code)
Je souhaiterai qu'à partir du fichier "Import_Valeur_Cherchée" onglet "Résultat" :
1 - je clique sur le bouton "recherche",
2 - je colle le N° qui appelle,
3 - le code va lire tous les classeurs (fermés) et s'il trouve, il me copie la ligne (où les lignes si plusieurs) dans ce classeur dans l'onglet "Résultat"
Pour tests codes, je joins les classeurs :
Import_Valeur_Cherchée (qui contient dans l'onglet "Ce que je voudrais faire", l'explication détaillée de mon besoin)
Classeur_1 - Classeur_2 - Classeur_3
+ classeur qui contient d’excellents codes de SilkyRoadqui me semblent proches de mon besoin.
En espérant que vous pourrez, une nouvelle fois m'aider et vous en remerciant,
Je vous souhaite à toutes et à tous une très belle journée.
Amicalement,
Lionel,
J'ai un beug quand je copie ton code dans le fichier "Import_Valeur_Cherchée(2)" de travail, sans rien modifier, sauf "données" qui devient "RendezVous" (feuille de recherche dans les classeurs : h = ExecuteExcel4Macro("MATCH(9^99," & f & "C14)")
pkoi & f & "C14)
et je ne comprends pas cette ligne aux.[A1].Resize(h, 27).FormulaArray = "=" & f & "R1C9:R" & h & "C35" 'formule de liaison matricielle
tablo = aux.[A1].Resize(h, 27) 'matrice, plus rapide
Pourtant ça fonctionne bien avec les fichiers tests
J'ai amélioré le code et les temps de réponse qui sont instantané pour des fichiers de :
3 x Classeur de 18 000 Lignes
je colle le code ci-dessous : que j'ai largement commenté :
Les feuilles du classeurs Excel sont considéré comme des tables Access / Pour en faire des requêtes.
soit dans chaque classeur la Feuille Donnees sert de tables
' Nom de la feuille dans le classeur fermé (Toujours le même nom)
Const CstFeuil As String = "Donnees"
Toutes les entêtes de colonnes doivent être mentionnées (c'est des champs)
Nb : cette feuille doit être utilisé et formaté et remplis comme une vrais base de données.
La requête pour extraire les numéros de téléphone est la suivante : pour excel VBA
Extraction.Requete = "SELECT * FROM [" & CstFeuil & "$] WHERE tel1 = " & RechTel & " OR " & "tel2 = " & RechTel & ";"
' Le resultat de la requête est stocké dans une variable tableau et cette variable tableau n'est pas compatible au format excel :
La variable tableau commence a la position 0
Pour excel et copier les donné elle commence a la position 1
Nb : Le résultat de la requête copie toute la ligne comme une vrais base
dans le cas présent nous avons pas besoin de 8 premières colonnes.
je passe par une fonction de transfert des valeurs concerné et avec la transposition (j'ai essaie de détailler un maximum le code aussi)
la fonction : Private Function trasposeTab(ByRef m_TabResult() As Variant) As Variant()
ensuite je transfert le résultat dans la feuille excel cible :
.
' ************************************************************************
changer le chemin de la constante
' Adresse ou sont ranger les 6 classeurs Fermés
Const CstPath As String = "C:\Users\laure\Desktop\lire classeur fermer vba\Version 1\"
Module standard : Recherche
VB:
Public Extraction As ExtractionClasseurFermer
Sub RequeteClasseurFerme()
' Fige l'écran
Application.ScreenUpdating = False
' Resultat du numéro de téléphone demander
Dim RechTel As String
' Adresse ou sont ranger les 6 classeurs Fermés
Const CstPath As String = "C:\Users\laure\Desktop\lire classeur fermer vba\Version 1\"
' Nom des classeurs fermer pour aller lire les informations.
Dim TabClassFermer(1 To 3) As String
'Pour Exemple :
TabClassFermer(1) = "Classeur_1.xlsm"
TabClassFermer(2) = "Classeur_2.xlsm"
TabClassFermer(3) = "Classeur_3.xlsm"
' Nom de la feuille dans le classeur fermé (Toujours le même nom)
Const CstFeuil As String = "Donnees"
' Demande du numéro de telephone dans inputbox
RechTel = InputBox("Info sur : Numéro téléphone a consulter")
For i = LBound(TabClassFermer) To UBound(TabClassFermer)
' Utilisation du module de classe !
Set Extraction = New ExtractionClasseurFermer
' Numéro demandé !
Extraction.RechTel = RechTel
' Le premier classeur de la boucle
Extraction.ClasseurFermer(CstPath & TabClassFermer(i)) = CstFeuil
' Définit la requête.
'Dim TxtSql As String
'/!\ Attention à ne pas oublier le symbole $ après le nom de la feuille.
'Extraction.Requete = "SELECT * FROM [" & CstFeuil & "$]" '& " WHERE tel1 = '" & 33111111104# & "'"
'Extraction.Requete = "SELECT * FROM [" & CstFeuil & "$] WHERE tel1 = " & "33111111104" & " OR " & "tel2 = " & "33111111104" & ";"
Extraction.Requete = "SELECT * FROM [" & CstFeuil & "$] WHERE tel1 = " & RechTel & " OR " & "tel2 = " & RechTel & ";"
' Extrait le resultat
Extraction.RequeteClasseurFerme
'--- Decharge le module de classe et Fermeture la connexion au classeur fermé ---
Set Extraction = Nothing
Next i
' decharge les variables
RechTel = Empty
'CstPath = Empty
Erase TabClassFermer
'CstFeuil = Empty
' Réactive l'écran
Application.ScreenUpdating = True
End Sub
Module de classe : ExtractionClasseurFermer
VB:
' Connexion
Private m_Cn As ADODB.Connection
Private m_Fichier As String
Private m_NomFeuille As String
Private m_TxtSql As String
Private m_Cmd As ADODB.Command
Private m_Rst As ADODB.Recordset
' TELEPHONE A TROUVER
Private m_RepTelp As String
' RESULTAT DE LA REQUETE DANS LA VARIABLE TABLEAU
Private m_TabResult() As Variant
' Stock le tableau m_TabResultTemp (Dans une variable tableau une dimension)
Private m_TabResultExcel() As Variant
' Compte les lignes ou sont trouver les numéro de téléphone
Private m_cpt As Double
' Resultat des lignes a copier / soit 1 ligne pour 27 colonnes
Private m_TabResultTemp(1 To 1, 1 To 27) As Variant
Private Sub Class_Initialize()
'--- Connection ---
Set m_Cn = New ADODB.Connection
Set m_Rst = New ADODB.Recordset
End Sub
Property Let RechTel(ByRef RepTelp As String)
m_RepTelp = RepTelp
End Property
Property Let ClasseurFermer(ByRef Fichier As String, ByRef NomFeuille As String)
'Définit le classeur fermé servant de base de données
m_Fichier = Fichier
'Nom de la feuille dans le classeur fermé
m_NomFeuille = NomFeuille
End Property
Property Let Requete(ByRef TxtSql As String)
'Définit la requête.
m_TxtSql = TxtSql
End Property
Sub RequeteClasseurFerme()
' Etablir la connexion
With m_Cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & m_Fichier & _
";Extended Properties=Excel 8.0;"
.Open
End With
' Etablir la commande
Set m_Cmd = New Command
m_Cmd.CommandType = adCmdText
m_Cmd.CommandText = m_TxtSql
' Executé la requête
Set m_Rst = m_Cn.Execute(m_Cmd.CommandText)
' Transfert la requete dans une variable tableau
m_TabResult = m_Rst.GetRows(m_Rst.RecordCount)
' Convertir la variable tableau au format excel via une fonction.
m_TabResult = trasposeTab(m_TabResult)
' Copie le tableau entier = le resultat de la requete
'Sheets("Résultat").Cells(Sheets("Résultat").Cells(65536, 9).End(xlUp).Row + 1, 9).Select
Sheets("Résultat").Cells(Sheets("Résultat").Cells(65536, 9).End(xlUp).Row + 1, 9).Resize(UBound(m_TabResult, 1), UBound(m_TabResult, 2)).Value = m_TabResult
End Sub
Private Function trasposeTab(ByRef m_TabResult() As Variant) As Variant()
' Fonction qui convertie les données de la variable tableau récupérer par le recordeset
' et transpose les données pour être au format excel
' Nb : Le tableau commence a 0 pour les des données récupérer du recorset
' Pour excel elle doivent etre a 1
' D'ou le + 1 ici = ReDim m_TabTemp(1 To UBound(m_TabResult, 2) + 1, 1 To UBound(m_TabResult, 1) + 1)
' Tableau extrait de la requête = UBound(m_TabResult, 1) soit 35 colonnes de 0 a 34 (Variable tableau actuel : m_TabResult)
' Pour excel = UBound(m_TabResult, 1) + 1 soit 35 colonnes de 1 a 35 (Variable nouvelle variable tableau : m_TabTemp)
' les colonnes a recopier sont de I à AJ dans la feuille excel
' donc 27 colonnes a recopier
' donc UBound(m_TabResult, 1) - 8 + 1 : soit 27 colonnes
' Ligne : 1 à UBound(m_TabResult, 2) + 1
' Colonne : 1 à UBound(m_TabResult, 1) - 8 + 1
Dim i As Long
Dim j As Long
Dim m_TabTemp() As Variant
ReDim m_TabTemp(1 To UBound(m_TabResult, 2) + 1, 1 To UBound(m_TabResult, 1) - 8 + 1)
' transfert des lignes et colonnes en transposition
' uniquement les colonnes a recopier voir ci-avant explication.
For i = LBound(m_TabResult, 1) + 8 To UBound(m_TabResult, 1) ' Colonne de 0 + 8 a 34
For j = LBound(m_TabResult, 2) To UBound(m_TabResult, 2) 'Ligne de 0 à le contenu de la récupération requête SQL
m_TabTemp(j + 1, i - 7) = m_TabResult(i, j)
Next j
Next i
' Explication
' Pour le tableau "m_TabResult = la position commence a 0" et pour le tableau "m_TabTemp = la postion commence a 1"
' Il faut donc ajuster le decalage
' - Pour i le dédut de la boucle commence a "LBound(m_TabResult, 1) + 8 soit 8 donc i = 8"
' - Pour j le dédut de la boucle commence a "LBound(m_TabResult, 2) soit 0 donc j = 0"
' Il faut donc que pour le départ et synchronisé les deux variables pour le remplissage
' Transposé les valeur le i,j du tableau m_TabResult correspond au j,i du tableau m_TabTemp
' Pour le tableau m_TabResult le i qui est égale a 0 doit être égale au tableau m_TabTemp pour je j qui doit être égale a 1 soit j+1 = 1
' Pour le tableau m_TabResult le j qui est égale a 0 doit être égale au tableau m_TabTemp pour le i qui lui commence :
' a la valeur 8 pour le i LBound(m_TabResult, 1) + 8 qui en faite et i = 0 + 8 autres valeurs soit 9
' i commence a 0 / 1 / 2 / 3 / 4 / 5 / 6 / 7 / 8 donc le i est a la 9 éme valeurs donc
' i a 35 Valeurs de 0 a 34 Cases
' i commence a 8 donc de La case 8 a 34 et pour compatibilité excel de 1 à 35 donc
' i - 7 / la la valeur de i est égale a 8 soit la neuvieme case du tableau et pour qu'elle soit compatible avec la case
' du nouveau tableau qui doit commencé a 1 / il faut écrire i - 7 = égale à 1
trasposeTab = m_TabTemp
Erase m_TabTemp
End Function
Private Sub Class_Terminate()
' Ici ont décharge toutes les variables
m_Fichier = Empty
m_NomFeuille = Empty
m_TxtSql = Empty
'--- Fermeture connexion ---
Set m_Rst = Nothing
Set m_Cmd = Nothing
m_Cn.Close
Set m_Cn = Nothing
' TELEPHONE A TROUVER
m_RepTelp = Empty
' RESULTAT DE LA REQUETE DANS LA VARIABLE TABLEAU
Erase m_TabResult
' Stock le tableau m_TabResultTemp (Dans une variable tableau une dimension)
Erase m_TabResultExcel
' Compte les lignes ou sont trouver les numéro de téléphone
m_cpt = Empty
' Resultat des lignes a copier / soit 1 ligne pour 27 colonnes
Erase m_TabResultTemp
End Sub
Ps : Peux être en se connectant de cette facon avec "un Couplage du MySql avec Excel"
Pour commencer il est nécessaire de télécharger et d'installer un 'Connector/ODBC' disponible sur cette page :
Le 1er devrait pouvoir être résolu :
Dans ton code tu as prévu (comme je l'avais demandé pour 27 colonnes)
En fait, j'ai besoin de copier 51 colonnes dans le classeur "Import_Valeur_Cherchée"
pour cela j'ai modifié les lignes de codes suivantes :
ReDim resu(1 To Rows.Count, 1 To 27) = ReDim resu(1 To Rows.Count, 1 To 51)
aux.[A1].Resize(h, 27).FormulaArray = "=" & f & "R1C9:R" & h & "C35" = aux.[A1].Resize(h, 51).FormulaArray = "=" & f & "R1C9:R" & h & "C35"
tablo = aux.[A1].Resize(h, 27) = tablo = aux.[A1].Resize(h, 51)
For j = 1 To 27 = For j = 1 To 51 'si je mets 51 ici ça beugue If n Then .Resize(n, 27) = resu = If n Then .Resize(n, 51) = resu
.Offset(n).Resize(Rows.Count - n - .Row + 1, 51).ClearContents = .Offset(n).Resize(Rows.Count - n - .Row + 1, 51).ClearContents
c'est cette ligne qui pose problème et que je ne peux pas modifier : For j = 1 To 27 = For j = 1 To 51 'si je mets 51 ici ça beugue Donc, je n'ai pas la copie de mes 51 colonnes ( je n'ai que 27 colonnes).
Encore merci Gérard pour ta patience et pour tout ce que tu fais
Lionel,
Déjà merci aux deux codeurs et à Arthour pour ces échanges nourris et les codes proposés.
Si l'avancement est déjà prometteur, je m'interroge concernant le délai de traitement de classeurs lourds (nb lignes, nb colonnes, formules) à manipuler sur excel et la possibilité, sur ce constat, de devoir aborder le problème un peu différemment.
Constat : On ne travaille sur sur les numéros de téléphones.
1> Il ne serait pas inutile de ne venir comparer le numéro de téléphone (inputbox) qu'à la liste à jour des téléphones des 3 bases (qu'on peut rappatrier par macro à différents moments de la journée (batch)).
> ci-joint un fichier contenant une macro très rapide pour venir afficher le classeur, la référence, l'adresse dans le classeur et le row de référence à partir des données des trois premières feuille (base actualisée des numéros de téléphones) avec pour chaque base plus de 30000 numéros de téléphone sur chaque colonne (F et G).
2> A partir de cette référence connue (classeur/ligne), on viendrait copier la plage correspondante sans avoir besoin de la rechercher dans le tableau.
(Pas travaillé encore)
Et on peut imaginer un lien hypertexte pour aller directement sur la référence (on a le classeur et l'adresse).
Qu'en pensez-vous ?
Je vous remercie pour votre réponse par rapport à cette approche... même si elle est pour vous critiquable inutile.
Bon sang : je ne comprends rien
Je viens de vérifier tous mes fichiers
et les colonnes N et O code If CStr(tablo(i, 6)) = tel Or CStr(tablo(i, 7)) = tel Then
sont bien sous forme de nombres ... ça beugue
Ce site utilise des cookies pour personnaliser le contenu, adapter votre expérience et vous garder connecté si vous vous enregistrez.
En continuant à utiliser ce site, vous consentez à notre utilisation de cookies.
