[Résolu] Problèmes avec inputbox

[Toine45]

Bonjour à tous
je débute en VBA et ça fait plusieurs semaines que je tourne en rond avec une macro
Je 'arrive pas à définir une colonne variable (x1 à dernière cellule remplie de x)

Voici mon code:

Sub A_inventaire_par_Boites_Dialogue_Test() ' Ne fonctionne pas, (en cours de modifs)

Rem -compare la cellule "A2" de la colonne "A" feuille "Essai" classeur "Inventaire-Essai.xls" avec toutes les cellules de la colonne "B" de la feuille "Recapitulatif" du classeur "1Emplacement"
'Si une valeur identique est trouvée: Remplacer le contenu de la cellule "3" (C) de la feuille Essai du classeur "Inventaire-Essai.xls"
'par le contenu de la cellule de la colonne "J" de la feuille "Recapitulatif" du classeur "1Emplacement" dont la valeur est la même.
'Sinon reprendre la comparaison a la cellule "A3" et ce jusqu'à la fin de la colonne "A"
    'Travail sur 2 feuilles dans 2 classeurs différents)
'Choix des classeurs, des feuilles et des colonnes à comparer et à copier : par inputbox (ou par userform)

'Définition =======================
Dim Cel As Range, Cel_A As Range
Dim F_A As Worksheet, F_B As Worksheet ', x As Worksheet, y As Worksheet, z As Worksheet
Dim Fi1 As String, Fi2 As String, F1 As String, F2 As String, co1 As Range, co2 As Range, C1 As String, C2 As String, Dep As String, Ar As String

'Attribution des variables ==============================
Fi1 = InputBox("Nom du fichier 1", "Nom1")
Fi2 = InputBox("Nom du fichier 2", "Nom2")
F1 = InputBox("Nom de la feuille 1", "Feuil1")
F2 = InputBox("Nom de la feuille 2", "Feuil2")
'On Error GoTo ErreurFichier

    C1 = InputBox("Colonne de référence 1", "Colonne1")
    C2 = InputBox("Colonne de référence 2", "Colonne2")
    
    Dep = InputBox("Nombre de colonne entre la Colonne de référence et la colonne de copie", "Depart")
    Ar = InputBox("Colonne d' arrivée (collage)", "Arrivee")

   Set co1 = [(C1) & "2": (C1)& Selection.End(xlUp)].Range 'Problème : (c'est là que ça coince)
   Set co2 = [C2 & "2": C2& Selection.End(xlUp)].Range     'Problème : (là,ça doit coincer aussi)
   
Set F_A = Workbooks(Fi1 & ".xls").Sheets(F1).Range(co1)
Set F_B = Workbooks(Fi2 & ".xls").Sheets(F2).Range(co2)

'Traitement =======================
    'F_A = feuille du classeur déterminés par inputbox
 
    'For Each Cel In F_A.Range(F_A.[A1], F_A.Range("A" & Rows.Count).End(xlUp))
For Each Cel In co1
    If Not (IsEmpty(Cel)) Then  'si Cel n'est pas vide
   
    'Set Cel_A = F_B.Columns(2).Find(Cel)  'Columns(2)= colonne B
        'fixer Cel_a en tant cellule trouvée identique à Cel
        'Set Cel_A = co2
                   If Not (co2 Is Nothing) Then
                    'si Cel_A existe
F_B.Range(Cel_A.Offset(0, Dep), Cel_A.Offset(0, Dep)).Copy F_A.Cells(Cel.Row, (Ar))
            'F_B.Range(Cel_A.Offset(0, 4), Cel_A.Offset(0, 4)).Copy F_A.Cells(Cel.Row, "C")
            'Copie les cellules F de la feuille 4 en C de la feuille 3
            '(J=9 : Colonne de référence + différence pour colonne à copier)

       End If
    End If
Next Cel    'Boucle sur cellule suivante
Exit Sub
ErreurFichier:
MsgBox "!Erreur de nom de classeur ou de feuille !"
End Sub

Au départ, j'étais parti pour faire ça d'après un userform, mais je n'y arrive pas non plus (je me re-pencherai dessus lorsque ça fonctionnera avec les inputbox, ça devrais être plus facile pour moi de comprendre la logique.
j'avais fait pour cela une demande d'aide il y a quelque semaine, restée sans réponse susceptible de m'aider.
je repart donc sur du "plus facile" (je pense), espérant que, cette fois, quelqu'un connaitra la syntaxe d'écriture pour mon problème.
avec tous mes remerciements anticipés
Cordialement.

 

[JBARBE]

Re : Problèmes avec inputbox

Bonjour à tous,

Je pense que ces lignes sont un probléme !

C1 = InputBox("Colonne de référence 1", "Colonne1")
C2 = InputBox("Colonne de référence 2", "Colonne2")

En effet définir C1 et C2 qui sont les cellules n'est pas correct dans une macro !

bonne soirée

 

[Staple1600]

Re : Problèmes avec inputbox

Bonjour à tous

Voici une manière d'écrire le code pour définir des colonnes
Code vba:
Sub defcol()
Dim co1 As Range, co2 As Range, dl1&, dl2&
'Set co1 = [(C1) & "2": (C1)& Selection.End(xlUp)].Range 'Problème : (c'est là que ça coince)
'Set co2 = [C2 & "2": C2& Selection.End(xlUp)].Range 'Problème : (là,ça doit coincer aussi)
dl1 = Cells(Rows.Count, "C").End(xlUp).Row
dl2 = Cells(Rows.Count, "D").End(xlUp).Row
Set co1 = Range("C1:C" & dl1)
Set co2 = Range("D1" & dl2)
End Sub

EDITION: Bonsoir Robert

 

[Robert]

Re : Problèmes avec inputbox

bonsoir le fil, bonsoir le forum,

Pas sûr d'avoir tout compris... Peut-être comme ça :

Sub A_inventaire_par_Boites_Dialogue_Test() ' Ne fonctionne pas, (en cours de modifs)Rem -compare la cellule "A2" de la colonne "A" feuille "Essai" classeur "Inventaire-Essai.xls" avec toutes les cellules de la colonne "B" de la feuille "Recapitulatif" du classeur "1Emplacement"
'Si une valeur identique est trouvée: Remplacer le contenu de la cellule "3" (C) de la feuille Essai du classeur "Inventaire-Essai.xls"
'par le contenu de la cellule de la colonne "J" de la feuille "Recapitulatif" du classeur "1Emplacement" dont la valeur est la même.
'Sinon reprendre la comparaison a la cellule "A3" et ce jusqu'à la fin de la colonne "A"
'Travail sur 2 feuilles dans 2 classeurs différents)
'Choix des classeurs, des feuilles et des colonnes à comparer et à copier : par inputbox (ou par userform)
'Définition =======================
Dim Fi1 As String
Dim cl1 As Workbook 'déclare la variable cl1 (CLasseur1)
Dim Fi2 As String
Dim cl2 As Workbook 'déclare la variable cl2 (CLasseur2)
Dim o1 As Object 'déclare la variable o1 (Onglet du classeur 1)
Dim o2 As Object 'déclare la variable o2 (Onglet du classeur é)
Dim C1 As String
Dim dl1 As Integer 'déclare la variable dl1 (Dernière Ligne 1)
Dim C2 As String
Dim dl2 As Integer 'déclare la variable dl2 (Dernière Ligne 2)
Dim Dep As String
Dim Ar As String
Dim co1 As Range
Dim co2 As Range
Dim r As Range 'déclare la variable r (Recherche)
Dim Cel As Range 'déclare la variable cel (CELlule)
Dim pa As String 'déclare la variable pa (Première Adresse)


'Attribution des variables ==============================
On Error GoTo ErreurFichier
Fi1 = InputBox("Nom du fichier 1", "Nom1")
Set cl1 = Workbooks(Fi1 & ".xls") 'définit le classeur cl1
Fi2 = InputBox("Nom du fichier 2", "Nom2")
Set cl2 = Workbooks(Fi2 & ".xls") 'définit le classeur cl2
F1 = InputBox("Nom de la feuille 1", "Feuil1")
Set o1 = cl1.Sheets(F1) 'définit l'onglet o1 du classeur 1
F2 = InputBox("Nom de la feuille 2", "Feuil2")
Set o2 = cl2.Sheets(F2) 'définit l'onglet o2 du classeur 2
On Error GoTo 0
C1 = InputBox("Colonne de référence 1", "Colonne1")
dl1 = o1.Cells(Application.Rows.Count, C1).End(xlUp).Row 'définit la dernière ligne éditée dl1 de la colonne de référence C1
C2 = InputBox("Colonne de référence 2", "Colonne2")
dl2 = o2.Cells(Application.Rows.Count, C2).End(xlUp).Row 'définit la dernière ligne éditée dl2 de la colonne de référence C2
Dep = InputBox("Nombre de colonne entre la Colonne de référence et la colonne de copie", "Depart")
Ar = InputBox("Colonne d' arrivée (collage)", "Arrivee")
Set co1 = o1.Range(C1 & "2:" & C1 & dl1) 'définit la plage co1
Set co2 = o2.Range(C2 & "2:" & C2 & dl2) 'définit la plage co2
'Traitement =======================
For Each Cel In co1 'boucle sur toutes les cellules cel de la plage co1
    If Cel.Value <> "" Then 'condition 1 : si Cel n'est pas vide
        Debug.Print Cel.Value
        Set r = o2.Columns(C2).Find(Cel.Value, , xlValues, xlWhole) 'définit la recherche r
        If Not r Is Nothing Then 'condition 2 : si il existe au moins une occurrence trouvée
            pa = r.Address 'définit l'adresse pa de la première occurrence trouvée
            Do 'exécute
                Range(Cel.Offset(0, 1), Cel.Offset(0, Dep)).Copy o2.Cells(r.Row, Ar) 'à adapter j'ai pas compris ce aue tu voulais exactement
                Set r = o2.Columns(C2).FindNext(r) 'redéfinit la recherche r (occurrence suivante)
            Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe des occurrences ailleurs au'en pa
        End If 'fin de la condition 2
    End If 'fin de la condition 1
Next Cel    'Boucle sur cellule suivante
Exit Sub
ErreurFichier:
MsgBox "!Erreur de nom de classeur ou de feuille !"
End Sub

 

[Toine45]

Re : Problèmes avec inputbox

Bonjour à tous
et merci à vous 3 pour avoir pris du temps pour m'aider
et plus particulièrement à Robert qui vient de m'enlever une grande épine du pied.
ça marche enfin presque. c'est sur la bonne voie, alors qu'avant, je n'avais que des messages d'erreur, ou, au mieux, il ne se passait rien.

Je joins mes fichier (le classeur 1 est à comparer avec le classeur 5 (la macro est dans Clas5 dans ThisWorkbooks)

(Ce que je veux faire
But : Comparer la colonne de référence de la feuille W du classeur 1 avec la colonne de rérérence de la feuille X du classeur 2 et, si une référence de la colonne référence de la feuille W est trouvée, dans la colonne référence de la feuille X : copier les données de la cellule Y de la feuille X du classeur 2 (se trouvant sur la même ligne que la référence cherchée), dans la cellule Z de la feuille W du classeur 1 (en face de cette même référence).
Si la référence n’est pas trouvée dans la feuille X, ne rien copier.

J'ai dû modifier un peu ta macro, car ça collait dans la mauvaise feuille et deux colonnes à la fois, alors qu'il ne m'en faut qu'une, maintenent, ça colle dans la bonne feuille, mais j'ai l'impression que ça ne copie pas les bons élements et qu'il y a un décalage. (ça doit copier de la colonne F de la feuille Toto du classeur Feuil5 pour coller dans la feuille AA colonne C du classeur Clas1. (avec ces classeurs là, car ça peux changer, selon ce que je détermine dans les inputbox, selon les classeurs utilisés.)

Les données à copier sont déterminées selon la comparaison de la colonne A de la feuille AA classeur1 avec la colonne B de la feuille Toto classeur 5 si égalité des cellules : copie le cellule en colonne F (sur la même ligne que la référence trouvée égale en colonne B (feuille Toto) pour être collée en colonne C de la feuille AA, sur la même ligne que la référence de comparaison positive en colonneA de la feuille AA classeur1.


1° Je suis arrivé à faire copier sur la bonne feuille, mais je ne vois pas pourquoi ce ne sont pas les bonnes données qui y sont copiées

2° Y a t'il possibilité de remplacer la variable : Dep = InputBox("Nombre de colonne entre la Colonne de référence et la colonne de copie", "Depart")
par le nom de la colonne (example F pour colonne F ou H pour colonne H) ce serait plus pratique.

3° Quelqu'un peut-t'il me conseiller pour adapter les variables dans un Userform ? (Dans le classeur Clas5 joint)
Maintenant que j'ai une base de travail valable et pratiquement fonctionnelle, je vais enfin pouvoir me pencher dessus (ça va être dur vu mon faible niveau en VBA) mais ça serait plus convivial pour l'utilisation.

Encore merci à tous et bon réveillon

 

[Robert]

Re : Problèmes avec inputbox

Bonsoir le fil, bonsoir le forum,

Je viens juste de passer avant de me coucher, Je regarderai ton problème demain. Ce que tu pourrais faire pour nous aider c'est, en plus des explications écrites, nous faire un fichier avec ce que tu as Avant la macro et ce que tu voudrais Après la macro. Avec des couleurs pour bien mettre tout cela en évidence... À demain.

 

[Toine45]

Re : Problèmes avec inputbox

Bonjour Robert
Encore merci de ton aide
Je joins mes fichiers (j'ai ajouté d'avantage de données pour mieux se rendre compte) les fichiers de travail sont Clas1 et Clas5 (la macro est dans Clas5.
merci encore et bon réveillon

 

[Robert]

Re : Problèmes avec inputbox

Bonjour le fil, bonjour le forum,

Je regarde pour passer par une UserForm. En attendant un code pour la macro qui devrqt convenir :

Sub A_inventaire_par_Boites_Dialogue_Test()

'Définition =======================
Dim nfref As String 'déclare la variable nfref (Nom du Fichier de REFérence)
Dim fref As Workbook 'déclare la variable fref (Fichier de REFérence)
Dim nfrech As String 'déclare la variable nfrech (Nom Fichier RECHerche)
Dim frech As Workbook 'déclare la variable frech (Fichier de RECHerche)
Dim noref As String 'déclare la variable noref (Nom Onglet de REFérence)
Dim oref As Object 'déclare la variable oref (Onglet de REFérence)
Dim norech As String 'déclare la variable norech (Nom Onglet de RECHerche)
Dim orech As Object 'déclare la variable orech (Onglet de RECHerche)
Dim colref As String 'déclare la variable colref (COLonne de REFérence)
Dim dlref As Integer 'déclare la variable dlref (Dernière Ligne de REFérence)
Dim colrech As String  'déclare la variable colrech (Colonne de RECHerche)
Dim dlrech As Integer 'déclare la variable dlrech (Dernière Ligne RECHerche)
Dim plref As Range 'déclare la variable plref (PLage de REFérence)
Dim plrech As Range 'déclare la variable plrech (PLage de RECHerche)
Dim cac As String 'déclare la variable cac (Colonne A Copier)
Dim cdst As String 'déclare la variable cdst (Colonne de DeSTination)
Dim r As Range 'déclare la variable r (Recherche)
Dim Cel As Range 'déclare la variable cel (CELlule)
Dim pa As String 'déclare la variable pa (Première Adresse)

'Attribution des variables ==============================
On Error GoTo ErreurFichier 'Si erreur de nom de classeur ou feuille : activation message d'erreur
nfref = InputBox("Nom du fichier de référence", "Référence") 'définit la variable nfref
If nfref = "" Then Exit Sub 'si boîte d'entrée non renseignée ou bouton "Annuler", sort de la procédure
Set fref = Workbooks(nfref & ".xls") 'définit le classeur fref
nfrech = InputBox("Nom du fichier de Recherche", "Recherche") 'définit la variable nfrech
If nfrech = "" Then Exit Sub 'si boîte d'entrée non renseignée ou bouton "Annuler", sort de la procédure
Set frech = Workbooks(nfrech & ".xls") 'définit le classeur frech
noref = InputBox("Nom de l'onglet de référence", "Référence") 'définit la variable noref
If noref = "" Then Exit Sub 'si boîte d'entrée non renseignée ou bouton "Annuler", sort de la procédure
Set oref = fref.Sheets(noref) 'définit l'onglet source oref du classeur source
norech = InputBox("Nom de l'onglet de recherche", "Recherche") 'définit la variable norech
If norech = "" Then Exit Sub 'si boîte d'entrée non renseignée ou bouton "Annuler", sort de la procédure
Set orech = frech.Sheets(norech) 'définit l'onglet orech du classeur cible
On Error GoTo 0 'annule la gestion des erreurs
colref = InputBox("Colonne de référence", "Référence") 'définit la variable colref
If colref = "" Then Exit Sub 'si boîte d'entrée non renseignée ou bouton "Annuler", sort de la procédure
dlref = oref.Cells(Application.Rows.Count, colref).End(xlUp).Row 'définit la dernière ligne éditée dlref de la colonne de référence colref
colrech = InputBox("Colonne de recherche", "Recherche")
If colrech = "" Then Exit Sub 'si boîte d'entrée non renseignée ou bouton "Annuler", sort de la procédure
dlrech = orech.Cells(Application.Rows.Count, colrech).End(xlUp).Row 'définit la dernière ligne éditée dlrech de la colonne de recherche colrech
Set plref = oref.Range(colref & "2:" & colref & dlref) 'définit la plage  de référence plref
Set plrech = orech.Range(colrech & "2:" & colrech & dlrech) 'définit la plage  de recherche plrech
cac = InputBox("Colonne de la cellule à copier", "Copier") 'définit la variable cac
cdst = InputBox("Colonne de destination", "Coller") 'définit la variable cdst

'Traitement =======================
For Each Cel In plref 'boucle sur toutes les cellules cel de la plage plref
    If Cel.Value <> "" Then 'condition 1 : si Cel n'est pas vide
        Set r = orech.Columns(colrech).Find(Cel.Value, , xlValues, xlWhole) 'définit la recherche r
        If Not r Is Nothing Then 'condition 2 : si il existe au moins une occurrence trouvée
            pa = r.Address 'définit l'adresse pa de la première occurrence trouvée
            Do 'exécute
            orech.Cells(r.Row, cac).Copy oref.Cells(Cel.Row, cdst)
            Set r = orech.Columns(colrech).FindNext(r) 'redéfinit la recherche r (occurrence suivante)
            Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe des occurrences ailleurs au'en pa
        End If 'fin de la condition 2
    End If 'fin de la condition 1
Next Cel    'Boucle sur cellule suivante
Exit Sub
ErreurFichier:
MsgBox "!Erreur de nom de classeur ou de feuille !"
End Sub

 

[Toine45]

Re : Problèmes avec inputbox

Bonjour
Merci beaucoup Robert
ça fonctionne impecable !

En fait, ta 1ère macro fonctionne maintenant aussi très bien, j'ai contourné le problème en inversant simplement les noms des classeurs, des feuilles et des colonnes de références, puis l'ordre d'affichage des inputbox (pour ne pas me tromper) (ça m'a pris quand même presque 4 heure, le temps de comprendre d'où venait le problème et coment le contourner) en fait, c'était tout bête.

mais là, nickel, sans rien retoucher.....
Je vois que j'ai encore énormément à apprendre
Maintenant, ma prochaine étape est de faire fonctionner tout ça en passent par mon userform (je le sent mal).

Merci encore et bonne soirée

 

[Robert]

Re : Problèmes avec inputbox

Bonsoir le fil, bonsoir le forum,

En pièce jointe ton fichier modifié avec une nouvelle UserForm. Si le(s) fichier(s) est(sont) déjà ouvert(s), utilise les comboboxes sinon ouvre le(s) via le(s) bouton(s) Ouvrir. Les comboboxes des onglets se mettent à jour automatiquement en fonction du classeur choisi. Les colonnes de référence/recherche ne sont sélectionables que parmi la(les) plage(s) utilisée(s). Les plages sont sélectionnées pour mieux visualiser les actions et un message d'explication est affiché à la fin de chaque Frame.
Code commenté...

Bon Réveillon !

le fichier :

 

[Toine45]

Re : Problèmes avec inputbox

Bonjour Robert
Bonjour à tous

Merci pour tout le temps que tu a passé pour résoudre mon problème

C'est vraiment super, Fonctionnement impécable et très convivial.
Le must c'est d'avoir commenté le tout : ça va beaucoup m'aider pour étudier le fonctionnement
je pourai ainsi essayer de refaire des macros utilisant ce principe pour d'autres besoins.

Tout ça en si peu de temps (il m'aurait fallu des mois pour arriver à quelque chose certainement beaucoup moins évolué)
Tu est vraiment un pro

Merci encore et bonne année 2014

 

[Robert]

Re : Problèmes avec inputbox

Bonjour le fil, bonjour le forum,

Tu est vraiment un pro

Ha ha ha... C'est sûr ! D'ailleurs au boulot on m'appelle pro-thèse (à cause de ma jambe en bois, mon œil de verre, ma perruque et mon dentier) ou pro-phète (faites-moi ceci, faites-moi cela)... Bonne Année !