VBA et excel

Version imprimable

VBA et excel

Bonjour le Forum,
J'ai un pb avec mon code:( :(

En fait je veux qu'il cherche les codes se trouvant en J dans la feuille (OF) dans la feuille (CRDB)
La difficulté est que certains code en J
se trouve au niveau de la colonne AD ou AM ou AF dans CRDB
Une fois le code trouvé qu'il me met la valeur correspondant en T de CRDB dans la colonne DM de OF. Mais j'ai du mal à formuler un code exacte
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 Sub Industry_sector() 'remplissage de la colonne DM de Openfonds, colonne créee Dim J As Long, Nblg As Long, Ligne As Long Dim F1 As Worksheet, F2 As Worksheet Dim Cel As Range Set F1 = Sheets("CRDB") Set F2 = Sheets("OF") F2.Range("DM2:DM400").ClearContents For J = 2 To F2.Range("J" & Rows.Count).End(xlUp).Row 'Set Cel = F5.Columns("AF").Find(what:=F1.Range("J" & J), LookIn:=xlValues, lookat:=xlWhole) 'If Not Cel Is Nothing Then 'F1.Range("DM" & Ligne) = F5.Range("T" & Cel.Row) Set Cel = F1.Columns("AD").Find(what:=F2.Range("J" & J), LookIn:=xlValues, lookat:=xlWhole) If Not Cel Is Nothing Then F2.Range("DM" & Ligne) = F2.Range("T" & Cel.Row) Ligne = Ligne + 1 End If Next J End Sub
Pour une meilleur visualisation, vous pouvez regarder la PJ

Merci d'avance

Bonjour,

Si j'ai bien compris

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Industry_sector()
Dim J As Long, Nblg As Long, Ligne As Long
Dim F1 As Worksheet, F2 As Worksheet
Dim Cel As Range
    Set F1 = Sheets("CRDB")
    Set F2 = Sheets("OF")
    F2.Range("DM2:DM400").ClearContents
    For J = 2 To F2.Range("J" & Rows.Count).End(xlUp).Row
        Set Cel = Application.Union(F1.Columns("AD"), F1.Columns("AF"), F1.Columns("AM")). _
        Find(what:=F2.Range("J" & J), LookIn:=xlValues, lookat:=xlWhole)
        If Not Cel Is Nothing Then
            F2.Range("DM" & J) = F1.Range("T" & Cel.Row)
        End If
    Next J
End Sub

Cordialement.

Merci pour votre réponse efficace et rapide :D

Vous avez bien compris ce que je voulais faire

Bonjour,

C'est encore moi, j'ai ma dernière question de la journée
en fait, la partie avec le if et left qui ne marche
Est ce que vous pouvez m'aider à retrouver l'erreur

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub Colonne_creee()
  'remplissage de la colonne DM de Openfonds, colonne créee
 
  Set F1 = Sheets("Openfonds")
  Set F5 = Sheets("CRDB")
 
  F1.Range("DK2:DM400").ClearContents
 
  For J = 2 To F1.Range("J" & Rows.Count).End(xlUp).Row
        Set Cel = Application.Union(F5.Columns("AD"), F5.Columns("AF"), F5.Columns("AM")). _
        Find(what:=F1.Range("J" & J), LookIn:=xlValues, lookat:=xlWhole)
        If Not Cel Is Nothing Then
            F1.Range("DM" & J) = F5.Range("T" & Cel.Row)
            F1.Range("DK" & Ligne) = Round(((F1.Range("AJ" & J) - F1.Range("A" & J)) / 366), 2)
        If Trim(F1.Range("BZ" & J)) = 1 Then
           F1.Range("DL" & Ligne) = Left((F1.Range("J" & J)), 2)
            Else
             F1.Range("DL" & Ligne) = " "
 
             Ligne = Ligne + 1
 
End If
End If
Next J
End Sub

NB: la colonne DM et DK se remplit parfaitement
c'est DL qui pose pb

Dernière question comment enregistré mes codes dans une autre fenêtre pour qu'il soit plus lisible

Merci d'avance

Cdt,

14/03/2013, 18h08
gFZT82

Je ne vois pas d'où sort la variable "Ligne". Elle n'est initialisée nulle part dans le code.

Pour la balise code, voir le lien suivant
http://club.developpez.com/regles/#L3.5

Cordialement.

Gauche VBA

Bonjour GF,

Merci de m'avoir parlé de l'initialisation de ligne, je l'avais complètement oublié. Ci dessous le code qui marche.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub Colonnes_creees()
  'remplissage de la colonne DM de Openfonds, colonne créee
 
  Set F1 = Sheets("Openfonds")
  Set F5 = Sheets("CRDB")
 
  F1.Range("DK2:DM400").ClearContents
 
  Ligne = 2
 
  For J = 2 To F1.Range("J" & Rows.Count).End(xlUp).Row
        Set Cel = Application.Union(F5.Columns("AD"), F5.Columns("AF"), F5.Columns("AM")). _
        Find(what:=F1.Range("J" & J), LookIn:=xlValues, lookat:=xlWhole)
        If Not Cel Is Nothing Then
            F1.Range("DM" & J) = F5.Range("T" & Cel.Row)
            F1.Range("DK" & J) = Round(((F1.Range("AJ" & J) - F1.Range("A" & J)) / 366), 2)
        If Trim(F1.Range("BZ" & J)) = 1 Then
           F1.Range("DL" & J) = Left((F1.Range("J" & J)), 2)
            Else
             F1.Range("DL" & J) = " "
 
             Ligne = Ligne + 1
 
End If
End If
Next J
End Sub

15/03/2013, 10h00
Philippe Tulliez
Bonjour Hamynaa,
Une petite remarque dans l'attribution des références aux variables objets F1 et F5. J'ajouterais l'objet parent (le classeur)
Exemple (si le classeur est celui où se trouve le code VBA)
Code:

1 2 3 4 Dim F1 As Worksheet, F5 As Worksheet With ThisWorkbook Set F1 = .Sheets("Openfonds"): Set F5 = .Sheets("CRDB") End With
Cela évite des surprises au cas où l'on exécute la procédure alors qu'un autre classeur est actif.
15/03/2013, 12h13
hamynaa

Merci Philippe :ccool:

J'ai fait les modifs, je suis une vrai débutante.
J'espère ne pas avoir des surprises avec mes codes :?