Discussion :

[awa123]

Bonjour ,

J’ai un classeur dans lequel il y a des données (le nom de sociétés associé aux usines qu’elles possèdent) et sur lesquelles le VBA calcule le nombre d’usines pour chaque société puis renvoie le résultat dans le classeur « récapitulatif » (cf. le code vba dans le classeur « données »).
Je voudrais un code VBA que je pourrai rajouter à celui déjà existant que je préconfigurerai et qui me permettrai ainsi de rajouter certaines données au classeur « récapitulatif » :
Par exemple à la fin du calcule, si il y a tel nom de société ou tel nom dans le classeur « récapitulatif », je veux que ça me rajoute sur la même ligne le chiffre « 4 » à tel colonne et le chiffre « 5 » à tel colonne par exemple.

Cf. le fichier « récapitulatif » en pièce jointe pour l’illustration.

Merci beaucoup

[Kimy_Ire]

Encore toi ? =D

Alors si j'ai bien compris, tu as des valeurs prédéfinies dans VBA pour certaines sociétés et tu voudrais que ces valeurs s'affichent uniquement si elles se trouvent dans ton fichier récapitulatif après l'exécution de ta macro, c'est ça ?

[Kimy_Ire]

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
73
74
75
76
77
78
79
80
81
82
83
84
85
Sub MoveData()
Dim cell_ori As Range
Dim cell_des As Range
Dim Chemin As String
Dim val As Integer
 
Dim table(1 To 30, 1 To 3) As Variant
 
table(1, 1) = "Coca cola"
table(1, 2) = 1337
table(1, 3) = 1338
 
table(2, 1) = "P&G"
table(2, 2) = 7331
table(2, 3) = 8331
 
table(3, 1) = "L'oréal"
table(3, 2) = 4
table(3, 3) = 300
 
 
 
Chemin = "C:\Users\mbourgeois\Desktop\récapitulatif.xlsx"
 
With Worksheets("données")
    'Open the destination workbook => pas très propre mais fonctionne
    On Error Resume Next
    Set Wk = Workbooks("récapitulatif")
    If Err <> 0 Then
        Err = 0
        'MsgBox "Ce fichier est fermé"
        Workbooks.Open Chemin
    Else
        'MsgBox "Ce fichier est ouvert"
    End If
 
 
    Set cell_ori = .Range("A2")
    For i = 1 To .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
        If cell_ori.Value <> "" Then
            val = 0
            For j = 0 To .Columns(2).Find("*", , , , xlByColumns, xlPrevious).Row
                If .Range("A1").Offset(j, 0).Value = cell_ori.Value Then
                    val = val + 1
'                Else
'                    Exit For
                End If
            Next j
 
 
            Set cell_des = Workbooks("récapitulatif").Worksheets("Recapitulatif").Range("A:A").Find(cell_ori.Value, LookIn:=xlFormulas, lookat:=xlWhole)
            If Not cell_des Is Nothing Then
                cell_des.Offset(0, 1) = val
            Else
                Set cell_des = Workbooks("récapitulatif").Worksheets("Recapitulatif").Range("A:A").Find("*", , , , xlByColumns, xlPrevious).Offset(1, 0)
                cell_des = cell_ori
                cell_des.Offset(0, 1) = val
            End If
 
            Set cell_ori = cell_ori.Offset(val, 0)
 
        Else
            Set cell_ori = cell_ori.Offset(1, 0)
        End If
    Next i
 
End With
 
 
With Workbooks("récapitulatif").Worksheets("Recapitulatif")
    Set cell_ori = .Range("A1")
    For i = 1 To UBound(table)
        For j = 1 To .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
            If table(i, 1) = cell_ori.Offset(j, 0) Then
                cell_ori.Offset(j, 2) = table(i, 2)
                cell_ori.Offset(j, 3) = table(i, 3)
            End If
        Next j
    Next i
End With
 
'Save and close the Workbook
'Workbooks("récapitulatif").Close True
 
End Sub

Place dans ton tableau à deux dimensions tes valeurs. Elles se placeront automatiquement aux endroits que tu as décrit.

Je pense que ce n'est pas forcément une bonne idée d'insérer en interne à VBA les données que tu veux déplacer, mais je t'ai procuré le code que tu demandais.

Conseil : fait un module au lieu de faire ce que tu as fait pour executer ta macro.

[awa123]

Bonjour,
Alors je me suis aperçu que deux petits problèmes persistent:

il y a un fichier "données" dans lequels toutes les données de base figure , et à partir duquel le code VBA va trier le noms des différentes villes puis renvoyer leurs valeurs correspondantes au fichier "recap"

Le premier probleme est que j'ai remarqué que l’algo. ne prend pas comptes toutes les différente villes et je ne comprends pas pourquoi. Lorsque j’exécute le programme ça m’affiche sur le fichier "recap" uniquement "paris" et "marseille" et négliges toutes les autres villes (malgré qu’il fonctionne très bien au niveau du compteur, il renvoi bien la bonne valeur en face de ces villes).

Le deuxième est lorsque j’utilise le code qu'il y a dans les posts au dessus m’a donné, ça m’affiche bien les valeurs que j'ai pré-rentrés dans le code mais pas dans la bonne colonne, j’aimerais réussir à rentrer les valeurs dans les colonnes «X, L et T » du classeur « recap »

Bref voir svp le classeur recap. pour l’illustration de ces Pbs
Merci beaucoup
J’espère avoir été assez clair

[Kimy_Ire]

1) Tu ne m'avais pas du tout demandé ça ! Tu m'avais demandé de calculer combien de villes il y avaient par société ! Et non pas le nombre de ville qu'il y avait dans ta colonne 2 (ou B). Pour le coup le code aurait été beaucoup plus simple.
Mais pour ne pas tout changer :

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
 
Sub MoveData()
Dim cell_ori As Range
Dim cell_des As Range
Dim Chemin As String
Dim val As Integer
 
Chemin = "C:\Users\...\recap.xlsx"
 
 
With Worksheets("Feuil1")
    'Open the destination workbook => pas très propre mais fonctionne
    On Error Resume Next
    Set Wk = Workbooks("fichier test vba\recap.xlsx")
      Application.ScreenUpdating = False
    If Err <> 0 Then
        Err = 0
        'MsgBox "Ce fichier est fermé"
        Workbooks.Open Chemin
    Else
        'MsgBox "Ce fichier est ouvert"
    End If
    On Error GoTo 0
     Set cell_ori = .Range("B2")
    For i = 1 To .Columns(2).Find("*", , , , xlByColumns, xlPrevious).Row
        If cell_ori.Value <> "" Then
            val = 0
            For j = 0 To .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
                If .Range("B2").Offset(j, 0).Value = cell_ori.Value Then
                    val = val + 1
'                Else
'                    Exit For
                End If
            Next j
 
 
            Set cell_des = Workbooks("recap").Worksheets("feuil1").Range("A:A").Find(cell_ori.Value, LookIn:=xlFormulas, lookat:=xlWhole)
            If Not cell_des Is Nothing Then
                cell_des.Offset(0, 4) = val
            Else
                Set cell_des = Workbooks("recap").Worksheets("feuil1").Range("A:A").Find("*", , , , xlByColumns, xlPrevious).Offset(1, 0)
                cell_des = cell_ori
                cell_des.Offset(0, 4) = val
            End If
 
            Set cell_ori = cell_ori.Offset(1, 0)
 
        Else
            Set cell_ori = cell_ori.Offset(1, 0)
        End If
    Next i
 
End With
 
'Save and close the Workbook
'Workbooks("récapitulatif").Close True
 
End Sub

Le code n'est pas optimisé mais fonctionne (il "réécrit" plusieurs fois les mêmes chiffres sur les mêmes cases). Pour autant, la vitesse d'execution sera rapide.

2) Dans le code que je t'avais donné :

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
Dim table(1 To 30, 1 To 3) As Variant
 
table(1, 1) = "Coca cola"
table(1, 2) = 1337
table(1, 3) = 1338
 
table(2, 1) = "P&G"
table(2, 2) = 7331
table(2, 3) = 8331
 
table(3, 1) = "L'oréal"
table(3, 2) = 4
table(3, 3) = 300
 
 
'... CODE ...
 
 
With Workbooks("récapitulatif").Worksheets("Recapitulatif")
    Set cell_ori = .Range("A1")
    For i = 1 To UBound(table)
        For j = 1 To .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
            If table(i, 1) = cell_ori.Offset(j, 0) Then
                cell_ori.Offset(j, 2) = table(i, 2)
                cell_ori.Offset(j, 3) = table(i, 3)
            End If
        Next j
    Next i
End With

J'ai créé un tableau à 2 dimensions dans lequel tu places tes données (prend un parpier et un crayon et fait un dessin).
- Sur la première ligne du tableau (il y a 30 colonnes : "1 To 30") on trouve les noms des recherches
=> table(1, 1) = "Coca cola" veux dire qu'à la première ligne première colonne on trouve "Coca Cola"
=> table(2, 1) = "P&G" veux dire qu'à la première ligne deuxième colonne on trouve "P&G"
=> table(3, 1) = "L'oréal" veux dire qu'à la première ligne troisième colonne on trouve "L'oréal"
Toutes les autres colonnes restant vide pour le moment.

- Tu auras compris le principe, tu remplies ta deuxième ligne par table(1, 2) = 1337 / table(2, 2) = 7331 / table(3, 2) = 4 laissant les autres colonnes vides.

Tu peux remplir ta troisième ligne avec les autres données placées.

Tu remarqueras qu'il n'y a que trois lignes à ton tableau : table(1 To 30, 1 To 3) (et toujours 30 colonnes dont 27 vides).

Bref, tout ca pour dire que maintenant que tu sais comment fonctionne ton tableau, tu as juste à placer les bonnes valeurs aux bons endroits.

Pour ma part, j'avais placé
If table(i, 1) = cell_ori.Offset(j, 0) Then => Lorsque je trouve une correspondance avec la première ligne de mon tableau qui sont (je répète) "Coca cola", "P&G" et "L'oréal" dans celui que j'avais créé
cell_ori.Offset(j, 2) = table(i, 2) => Je place la deuxième ligne du tableau à 2 cases à droite
cell_ori.Offset(j, 3) = table(i, 3) => Je place la troisième ligne du tableau à 3 case à droite

Remplace donc le 2 et le 3 par ce que tu veux (c'est-à-dire l'offset sur les colonnes que tu souhaites) avec les valeurs que tu veux !

En espérant avoir été suffisament clair à mon tour !

Bon courage !

PS : tes explications l'étaient, enfin, j'espère avoir compris tes problèmes ! ^^

EDIT : J'ai confondu lignes et colonnes mais ça revient exactement au même ! Un tableau est "virtuel" c'est toi qui choisi quelle case correspond à quoi. Mais dans la logique Excel, il faudrait faire l'inverse : soit 30 lignes et 3 colonnes.

[awa123]

Merci Kimy!

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
Dim table(1 To 30, 1 To 3) As Variant
 
table(1, 1) = "Paris"
table(1, 2) = 1337
table(1, 3) = 1338
 
table(2, 1) = "Marseille"
table(2, 2) = 14
table(2, 3) = 139
 
table(3, 1) = "Grenoble"
table(3, 2) = 14
table(3, 3) = 139
 
table(4, 1) = "Versailles"
table(4, 2) = 14
table(4, 3) = 139
 
....CODE......
 
With Workbooks("recap").Worksheets("feuil1")
    Set cell_ori = .Range("A1")
    For i = 1 To UBound(table)
        For j = 1 To .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
            If table(i, 1) = cell_ori.Offset(j, 0) Then
                cell_ori.Offset(j, 1) = table(i, 2)
                cell_ori.Offset(j, 2) = table(i, 3)
            End If
        Next j
    Next i
End With

lorsque je change le code code ci dessus :

Code :

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

1
2
cell_ori.Offset(j, 1) = table(i, 2)
cell_ori.Offset(j, 2) = table(i, 3)

j'arrive à remplir la colonne L et T mais je n'arrive toujours pas à remplir la fameuse colonne X....
cf. l'illustration en pièce jointe

que faut il faire pour qu'elle se remplisse enfin??
mercii