Archivage par array suivant condtion

[cathodique]

Bonjour à tous,

Je fus aidé pour parvenir à transférer des données sur une autre feuille en utilisant les tableaux et je remercie tous ceux qui m'ont donné un coup de main.

Option Explicit
Sub Archivage()
Dim i&, j&
Dim Plg As Range, PLg_EnTete As Range, C As Range
Dim T_EnTete As Variant, T_Data As Variant, T_Report As Variant
Dim dl As Long
Dim bd As Object
Set bd = Sheets("A") 'définit l'onglet bd
dl = bd.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit derlg col1 onglet bd
Application.ScreenUpdating = False          'désactive mise à jour écran

With Sheets("A")
    Set PLg_EnTete = .Range("B1:B5,F1,H1:H2")
    Set Plg = .Range(.Cells(8, 1), .Cells(.Rows.Count, 2).End(3).Offset(, 6))
    T_EnTete = .Range("A1:H5")
End With

T_Data = Plg
ReDim T_Report(1 To UBound(T_Data, 1), 1 To 30)

For i = LBound(T_Data, 1) To UBound(T_Data, 1)
    T_Report(i, 2) = "=ROW()-1"       'VAL1
    T_Report(i, 3) = CDate(T_EnTete(1, 5))  'VAL3
    T_Report(i, 18) = T_EnTete(4, 5)        'VAL18
    T_Report(i, 19) = T_EnTete(1, 2)        'VAL19
    'si VAL20= 0 et VAL21=0  alors sur feuille B VAL20=vide et VAL21=vide 
    T_Report(i, 20) = CDbl(T_EnTete(3, 2))  'VAL20 
    T_Report(i, 21) = CDbl(T_EnTete(4, 2))  'VAL21
    T_Report(i, 22) = T_EnTete(2, 2)        'VAL22
    T_Report(i, 23) = T_EnTete(5, 2)        'VAL23
    T_Report(i, 24) = T_EnTete(1, 8)        'VAL24
    T_Report(i, 25) = T_EnTete(2, 8)        'VAL25
   
   'On boucle sur les colonnes du tableau T_Report
    j = 1
    T_Report(i, j) = T_Data(i, j + 1)       'VAL1
    j = 4
    T_Report(i, j) = T_Data(i, j - 1)       'VAL4
   j = 7
   T_Report(i, j) = T_Data(i, j - 3)        'VAL7
   j = 9
   T_Report(i, j) = T_Data(i, j - 4)        'VAL9
   j = 15
   T_Report(i, j) = T_Data(i, j - 9)        'VAL15
   j = 16
   T_Report(i, j) = T_Data(i, j - 9)        'VAL16
   j = 17
   T_Report(i, j) = T_Data(i, j - 9)        'VAL17
Next i
Sheets("B").Cells(Rows.Count, 1).End(3)(2).Resize(UBound(T_Report, 1), UBound(T_Report, 2)) = T_Report

Application.ScreenUpdating = True
MsgBox "Terminé!"
End Sub

Je voudrai donc compléter ce code pour que si 2 cellules de la feuille source A sont simultanément nulles, les cellules respectives de destination seront vides. Sinon les archiver comme des numériques.

En vous remerciant par avance.

Cordialement,

 

[pierrejean]

Re : Archivage par array suivant condtion

Bonjour cathodique

A tester:

.....
T_Report(i, 19) = T_EnTete(1, 2)        'VAL19
    If CDbl(T_EnTete(3, 2)) <> 0 Then T_Report(i, 20) = CDbl(T_EnTete(3, 2)) 'VAL20
    If CDbl(T_EnTete(4, 2)) <> 0 Then T_Report(i, 21) = CDbl(T_EnTete(4, 2)) 'VAL21
T_Report(i, 22) = T_EnTete(2, 2)        'VAL22
......

 

[cathodique]

Re : Archivage par array suivant condtion

Bonsoir Pierrejean,

Je te remercie beaucoup. Ton code fonctionne bien. Mais je t'avoue ne pas bien connaitre les arrays et ne pas comprendre ton code très simple. je vois une vérification de la valeur de la cellule si différente de 0 alors (then) on transfère comme numérique et c'est tout. et ça fonctionne, Pourrais-tu éclairer ma lanterne?

Merci beaucoup. Très bonne soirée.

Cordialement,

 

[pierrejean]

Re : Archivage par array suivant condtion

Re

L'Array T_Report(i, 20) est vide depuis ReDim T_Report(1 To UBound(T_Data, 1), 1 To 30)
Donc Si CDbl(T_EnTete(3, 2)) <> 0 alors on le change en CDbl(T_EnTete(3, 2)) sinon il reste vide

 

[cathodique]

[RESOLU] : Archivage par array suivant condtion

Re

Je te suis vraiment reconnaissant. Merci pour ton aide et tes explications.

Cordialement,