Discussion :

[hamynaa]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[gFZT82]

Bonjour,

Si j'ai bien compris

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[hamynaa]

Merci pour votre réponse efficace et rapide

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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,

[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.

[hamynaa]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.