Discussion :

[ninette24]

Bonjour à tous...

Voilà, j'ai un petit problème,
Je souhaite alimenter une matrice préremplie (la matrice est dans la feuil4) elle est initialisée comme ceci

A
nom1
0 nom2
0 0 nom3
0 0 0 nom4
0 0 0 0 nom5

Dans ma feuil6 j'ai ma plage suivante

A B
nom2 livre1
nom5 livre2
nom1 livre2
nom3 livre3
nom4 livre1

Comme nom1 et nom5 ont le même livre et nom2 et nom4 ont le même livre
on remplira la matrice comme ceci :

A
nom1
0 nom2
0 0 nom3
0 1 0 nom4
1 0 0 0 nom5

Ces valeurs devront s'incrémenter en fonction des livres en commun par nom

J'ai dons écrit le code suivant :

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
 
Dim o, k, l, m, nom2, nom3
For o = 2 To 5600 'il ya 5600 lignes
k = Sheets("Feuil6").Cells(o, 2).Value
nom2 = Sheets("Feuil6").Cells(o, 1).Value
nom3 = Sheets("Feuil6").Cells(o + 1, 1).Value
 
n = Left(nom2, 15)
n1 = Left(nom3, 15)
If k <> "" Then
Rechligne1 = Sheets("Feuil4").Cells(o, o).Find(nom2).Row
Rechligne = Sheets("Feuil4").Cells(o + 1, o + 1).Find(nom3).Row
Rechcol1 = Sheets("Feuil4").Range("A1:HFK5560").Find(nom2).Column
Rechcol2 = Sheets("Feuil4").Range("A1:HFK5560").Find(nom3).Column
 
x = Rechligne1
y = Rechligne
Z = Rechcol1
t = Rechcol2
If Sheets("Feuil6").Cells(o + 1, 2).Value = k Then
If Left(nom2, 1) <> Left(nom3, 15) Then
If Left(nom2, 1) < Left(nom3, 15) Then
Sheets("Feuil4").Cells(y, Z).Value = Sheets("Feuil4").Cells(y, Z).Value + 1
Else
Sheets("Feuil4").Cells(x, t).Value = Sheets("Feuil4").Cells(x, t).Value + 1
End If
End If
End If
End If
Next o

Mais il ne s'execute pas, j'ai toujours une erreur, et la matrice ne s'alimente jamais....
Quelqu'un pour m'aider?

Merci...

[fred65200]

bonjour ninette24, pgz,

tu peux tester ce code avec l'utilisation d'un dictionnaire

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
Sub test()
Dim Data As Object
Dim i As Integer
Dim k As Integer
Dim Tablo As Variant
Dim tabMatrice() As Variant
Dim DerLi As Long
Dim F4 As Worksheet
Dim F6 As Worksheet
Dim Ligne As Long, Colonne As Long
 
Dim C As Range
 
Set F4 = Worksheets("Feuil4")
Set F6 = Worksheets("Feuil6")
 
DerLi = F6.Columns("B").Find("*", , , , , xlPrevious).Row
 
'Tri feuil6
If Val(Application.Version) < 12 Then
    F6.Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
Else
    F6.Sort.SortFields.Add Key:=Range("A1:A" & DerLi), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With F6.Sort
        .SetRange Range("A1:B" & DerLi)
    End With
End If
 
'Mise à zéro Feuil4
For Each C In F4.Range("A1").CurrentRegion
If C = 1 Then C = 0
Next C
 
'Création d'un dictionnaire pour trouver les doublons
Set Data = CreateObject("Scripting.Dictionary")
k = 0
 
Dim a As Variant
Tablo = F6.Range("B1:B" & DerLi).Value
 
For i = 1 To UBound(Tablo)
On Error Resume Next
    Data.Add Tablo(i, 1), i                                     'i = ligne, ajuster au besoin
    If Err.Number <> 0 Then                                     'si l'élément existe
        k = k + 1
        ReDim Preserve tabMatrice(3, k)
        tabMatrice(1, k) = Tablo(i, 1)                          'élément en double
        tabMatrice(2, k) = F6.Cells(i, 1)                       'posseseur 1
        tabMatrice(3, k) = F6.Cells(Data(Tablo(i, 1)), 1)       'posseseur 2
    End If
Next i
 
For i = 1 To UBound(tabMatrice)
    Ligne = F4.Range("A1").CurrentRegion.Find(tabMatrice(2, i), , , , , xlPrevious).Row
    Colonne = F4.Range("A1").CurrentRegion.Find(tabMatrice(3, i), , , , , xlPrevious).Column
    F4.Cells(Ligne, Colonne) = 1
Next i
 
End Sub

Cordialement

[pgz]

La disposition des noms dans la feuil4 n'aide pas. Ca gène même énormément pour travailler avec un tableau. Il y a donc plus simple si les noms sont tous dans la même colonne. Mais ce n'est pas le cas.

Il y a probablement quelque chose de plus amusant à faire en SQL, mais bon, je te propose cela

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
Sub subTriangle()
Dim shNoms As Excel.Worksheet, shLivres As Excel.Worksheet
Dim TabNoms() As String, vLivres As Variant
Dim nbNoms As Long, nbLivres As Long
Dim L As Long, X As Long, Y As Long, Z As Long
 
nbNoms = 5
nbLivres = 7
 
Set shNoms = Application.ThisWorkbook.Worksheets("Feuil4")
Set shLivres = Application.ThisWorkbook.Worksheets("Feuil6")
 
'chargement de la liste des noms
ReDim TabNoms(1 To nbNoms)
For L = 1 To nbNoms
    TabNoms(L) = shNoms.Cells(L, L)
Next L
 
'chargement du tableau Noms-Livres
vLivres = shLivres.Range(shLivres.Cells(1, 1), shLivres.Cells(nbLivres, 2)).Value
 
'scrutation triangle
Application.screenUpdating = False
For L = 2 To nbNoms
    'recherche des livres en rapport avec TabNoms(L)
    For X = 1 To nbLivres
        If vLivres(X, 1) = TabNoms(L) Then
            'le nom TabNoms(L) a été trouvé : lire le livre et chercher les autres noms
            For Y = 1 To nbLivres
                If (vLivres(Y, 2) = vLivres(X, 2)) And (vLivres(Y, 1) <> vLivres(X, 1)) Then
                    'rechercher le numéro de ligne du nom (y,1)
                    For Z = 1 To L - 1
                        If TabNoms(Z) = vLivres(Y, 1) Then Exit For
                    Next Z
                    If Z < L Then
                        shNoms.Cells(L, Z) = 1
                    End If
                End If
            Next Y
        End If
    Next X
 
Next L
 
Application.ScrennUpdating = True
Set shNoms = Nothing
Set shLivres = Nothing
vLivres = Null
Erase TabNoms
 
End Sub

Comme tu le vois j'ai testé sur un petit triangle. Tu dois mettre ou calculer les nombres de lignes en lieu et place des 5 et 7.
Avec 5600 lignes et colonnes, tu peux rencontrer 2 pb : mémoire et temps d'exécution.

PGZ