Discussion :

[SymB75]

Bonjour,

Je suis étudiant, en Finance. Dans le cadre de mon master il y a une introduction au VBA.
Nous devons créer un programme qui met en forme plusieurs feuilles de données.
Malheureusement, malgré quelques recherches, je continue d'avoir l'erreur "Erreur définie l'application ou par l'objet".

Voici mon code actuel :

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Worksheets("Data").Select
 
Dim derniere_ligne As Integer
      derniere_ligne = Range("A1").End(xlDown).Row 'Dernière ligne de la base de données
Dim i As Integer
Dim NoCol As Integer
    NoCol = 1 'lecture de la colonne 1
Dim NoLig As Long
Dim Var As Variant
Dim mySheetName As String
Dim mySheetNameTest As String
 
For i = 0 To derniere_ligne - 2 Step 1
 
    'Si la valeur de la cellule est différente de la cellule du dessus
    If Cells(i, 1).Value <> Cells(i - 1, 1).Value Then
 
        'On enregistre la key
        Dim KeyData As Integer
        KeyData = Range("A" & i).Value
 
        Sheets("Currencies").Select
        'On selectionne la première colonne
        Range("A1", Range("A1").End(xlDown)).Select
 
        'On parcourt les cellules de la colone pour trouver cellule avec même valeur
        Dim Cel As Range
            For Each Cel In Range("A1", Range("A1").End(xlDown))
                'Si la cellule de la colonne = KeyData on créer une feuille avec le nom le la cellule de droite.
                If Cel = KeyData Then
                    mySheetName = Sheets("Currencies").Range("B" & i)
                    On Error Resume Next
                    mySheetNameTest = Worksheets(mySheetName).Name
 
                    If Err.Number = 0 Then
                        MsgBox "The sheet named ''" & mySheetName & "'' DOES exist in this workbook."
                    Else
                        Err.Clear
                        Worksheets.Add.Name = mySheetName
                        MsgBox "The sheet named ''" & mySheetName & "'' did not exist in this workbook but it has been created now."
 
                        Sheets(mySheetName).Range("A1").Value = "FullDateAlternatekey"
                        Sheets(mySheetName).Range("B1").Value = "AverageRate"
                        Sheets(mySheetName).Range("C1").Value = "EndOfDayRate"
                        Sheets(mySheetName).Range("D1").Value = "Variation since the previous quotation"
                        Sheets(mySheetName).Range("E1").Value = "Day of the week"
 
                    End If
                End If
 
            Next Cel
    End If
 
 Next i

Savez vous d'où cela vient ? Je vous remercie.

[Invité]

Bonjour,

Savez vous sur quelle ligne ? Je vous remercie.

[Theze]

Bonjour,

Déjà ceci ne peut pas fonctionner :

Code :

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

1
2
3
4
5
 
For i = 0 To derniere_ligne - 2
 
    'Si la valeur de la cellule est différente de la cellule du dessus
    If Cells(i, 1).Value <> Cells(i - 1, 1).Value Then

car le numéro de ligne commence à 1 et non à 0 ! Donc, ce serait plutôt :

Code :

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

1
2
 
For i = 2 To derniere_ligne - 2

commencer à 2 car tu fais un I - 1 "Cells(i - 1, 1)"
Une piste. Evites les Select, Activate et choses du même genre, utilise plutôt des variables de type Worksheet :

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
 
Sub Test()
 
    Dim FeData As Worksheet
    Dim FeCurr As Worksheet
    Dim FeNouv As Worksheet
 
    Dim derniere_ligne As Integer
    Dim i As Integer
    Dim mySheetName As String
    Dim mySheetNameTest As String
    Dim KeyData As Integer
    Dim Cel As Range
 
    Set FeData = Worksheets("Data")
    Set FeCurr = Worksheets("Currencies")
 
    derniere_ligne = FeData.Cells(Rows.Count, 1).End(xlUp).Row 'Dernière ligne de la base de données
 
    For i = 2 To derniere_ligne - 2
 
        'Si la valeur de la cellule est différente de la cellule du dessus
        If FeData.Cells(i, 1).Value <> FeData.Cells(i - 1, 1).Value Then
 
            'On enregistre la key
            KeyData = FeData.Range("A" & i).Value
 
            'On parcourt les cellules de la colone pour trouver cellule avec même valeur
            For Each Cel In FeCurr.Range(FeCurr.Cells(1, 1), FeCurr.Cells(Rows.Count, 1).End(xlUp))
 
                'Si la cellule de la colonne = KeyData on créer une feuille avec le nom le la cellule de droite.
                If Cel.Value = KeyData Then
 
                    mySheetName = FeCurr.Range("B" & i).Value
 
                    On Error Resume Next
                    mySheetNameTest = Worksheets(mySheetName).Name
 
                    If Err.Number = 0 Then
 
                        MsgBox "The sheet named ''" & mySheetName & "'' DOES exist in this workbook."
 
                    Else
 
                        Err.Clear
 
                        MsgBox "The sheet named ''" & mySheetName & "'' did not exist in this workbook but it has been created now."
 
                        Set FeNouv = Worksheets.Add
 
                        With FeNouv
 
                            .Name = mySheetName
                            .Range("A1").Value = "FullDateAlternatekey"
                            .Range("B1").Value = "AverageRate"
                            .Range("C1").Value = "EndOfDayRate"
                            .Range("D1").Value = "Variation since the previous quotation"
                            .Range("E1").Value = "Day of the week"
 
                        End With
 
                    End If
 
                End If
 
            Next Cel
 
        End If
 
    Next i
 
End Sub

[SymB75]

Je te remercie, il fallait effectivement remplacer le 0 par 2...

Sujet résolu.