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
| Sub PPz()
Range("Tab_1").Select
T1C = Range("Tab_1").Column
T1l = Range("Tab_1").Row
Range("Tab_2").Select
T2C = Range("Tab_2").Column
T2l = Range("Tab_2").Row
MsgBox (T1C & " " & T1l & " " & T2C & " " & T2l & " ")
Call Limites(T1l, T1C, T1_CA_D, T1_CA_F, T1_CB_D, T1_CB_F, CatA, CatB)
Call Limites(T2l, T2C, T2_CA_D, T2_CA_F, T2_CB_D, T2_CB_F, CatA, CatB)
Ligne = T1l
Col = T1C + 3
Cells(Ligne, Col) = CatA
For i1 = T1_CA_D To T1_CA_F
Text_D = Cells(i1, T1C + 1)
For i2 = T2_CA_D To T2_CA_F
Cells(Ligne, Col + 1) = Text_D & "__" & Cells(i2, T2C + 1)
Ligne = Ligne + 1
Next
Next
Cells(Ligne, Col) = CatB
For i1 = T1_CB_D To T1_CB_F
Text_D = Cells(i1, T1C + 1)
For i2 = T2_CB_D To T2_CB_F
Cells(Ligne, Col + 1) = Text_D & "__" & Cells(i2, T2C + 1)
Ligne = Ligne + 1
Next
Next
End Sub
Sub Limites(T1l, T1C, T1_CA_D, T1_CA_F, T1_CB_D, T1_CB_F, CatA, CatB)
' Limites des tableaux
T1_CA_D = T1l
l = T1_CA_D - 1
CatA = Cells(T1_CA_D, T1C)
Do
l = l + 1
' Test de fin de Catégorie
If Cells(l, T1C) <> "" Then
T1_CA_F = l - 1
T1_CB_D = l
CatB = Cells(T1_CB_D, T1C)
End If
' Test de fin de tableau
Txt = Cells(l, T1C + 1)
If Txt = "" Then
T1_CB_F = l - 1
Exit Do
End If
Loop
MsgBox ("Limites du tableau : " & Chr(13) & _
"TX_CA_D : " & T1_CA_D & Chr(13) & _
"TX_CA_F : " & T1_CA_F & Chr(13) & _
"TX_CB_D : " & T1_CB_D & Chr(13) & _
"TX_CB_F : " & T1_CB_F & Chr(13))
End Sub |
Partager