Discussion :

[Rrrroh]

Bonjour à tous,
étant pleinement satisfait des réponses obtenus par ici, je m'adresse une nouvelle à vous.
Une petite explication sera plus claire que le titre:

je dispose d'une feuille (bdd), contenant 2 colonnes concernées du type:
A1 B2
A2 B2
A3 B2
A4 B1
A5 B3
A6 B3

j'ai créé une 2nd feuille que je souhaite mettre en forme de cette manière:
.........B2...B1...B3
A1......1.....0....0
A2......1.....0....0
A3......1.....0....0
A4......0.....1....0
A5......0.....0....1
A6......0.....0....1

(pour information il existe une centaine "de B" disons, pour prêt de 10 000 "A")

la mise en forme des "A" et des "B" est déjà codée, je souhaite désormais compléter le tableau de croisement.
Pour se faire j'ai écrit:

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
 
PremiereligneR = 5
Debutextract = 5
Finextract = Feuilcopiee.Range("A10000").End(xlUp).Row
DerniereLigne = Feuilreçu.Range("A30000").End(xlUp).Row
PremiereColB = 4
DerniereColB = Feuilreçu.Range("IV4").End(xlToLeft).Column
 
For I = Debutextract To Finextract
    For J = PremiereligneR To DerniereLigne
      For K = PremiereColB To DerniereColB
        If Feuilreçu.Cells(J, "A").Value = Feuilcopiee.Cells(I, "D").Value _
        And Feuilreçu.Cells(4, K).Value = Feuilcopiee.Cells(I, "B").Value Then
 
        'mettre 1 pour un croisement de données
        Feuilreçu.Cells(J, K).Value = 1
        'sinon 0
        Else: Feuilreçu.Cells(J, K).Value = 0
 
        End If
      Next K
    Next J
Next I

qui m'a très clairement montré (après avoir laisser tourner la macro 2h le temps de manger, pour finalement la couper en rentrant parce qu'elle ne bouclait pas), que ces rudiments vba n'étaient pas du tout adapté pour brasser autant de données...

je souhaiterais donc que vous m'aidiez en m'indiquant une méthode "viable".
je vous remercie par avance et vous souhaite un bon après midi

[zyhack]

Bonjour

J'ai essayé de faire correspondre le code à tes besoins mais il faudra peut être adapter, sinon ce code est très rapide.

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
 
Sub testB()
Dim wsh1 As Worksheet, wsh2 As Worksheet
Dim plage1 As Range, plageA As Range, plageB As Range
Dim F As Range, A As Range, B As Range
Set wsh1 = Worksheets("Feuilcopiee")
Set wsh2 = Worksheets("Feuilreçu")
Set plage1 = wsh1.Range("A5:A" & wsh1.Cells(Rows.Count, "A").End(xlUp).Row)
Set plageA = wsh2.Range("A5:A" & wsh2.Cells(Rows.Count, "A").End(xlUp).Row)
Set plageB = wsh2.Range(wsh2.Cells(4, 4), wsh2.Cells(4, wsh2.Cells(4, Columns.Count).End(xlToLeft).Column))
wsh2.Range("D5:" & wsh2.Range("D5").Offset(plageA.Rows.Count, plageB.Columns.Count - 1).Address) = 0
For Each F In plage1
  Set A = plageA.Find(wsh1.Range(F.Address).Offset(0, 3).Value, LookIn:=xlValues, lookat:=xlWhole)
  Set B = plageB.Find(wsh1.Range(F.Address).Offset(0, 1).Value, LookIn:=xlValues, lookat:=xlWhole)
  If Not A Is Nothing And Not B Is Nothing Then wsh2.Cells(A.Row, B.Column) = 1
Next
Set wsh1 = Nothing: Set wsh2 = Nothing
Set plage1 = Nothing: Set plageA = Nothing: Set plageB = Nothing
Set A = Nothing: Set B = Nothing
End Sub

[Rrrroh]

Génial le Offset!!
merci beaucoup zyhack