XL 2013 VBA / Transfert de dates avec condition

PMG

XLDnaute Junior
Bonjour Le fil, le forum,

Pourriez vous m'aider à corriger ma macro svp.
Je dois transférer des "dates féries" d'un tableau que si elles ne sont pas comprises dans les "dates congés" vers un tableau résultat. La macro marche presque (je m'améliore) mais j'ai des erreurs:

Je précise que c'est seulement la première colonne du tableau d'origine qui sert de référence (pas la deuxième qui sert à des calculs).

Problème 1:
La déclaration de mon tableau origine si la ligne du dessous n'est pas vide.

Problème 2:
La mise en forme est décalée ds le tableau résultat.

Merci bcp d'avance pour votre disponibilité.
PMG

VB:
Sub M_Calendrier_Transfert_Feries()
Dim ws_BD2 As Worksheet, ws_BD3 As Worksheet
Dim tablo_origine(), tablo_resultat(), Dte As Long, Lgn As Byte, x As Integer, Derlgn As Byte
Dim FirstDate As Long, LastDate As Long

'-----Transfert des feriés sans doublons avec les congés (BD2 vers BD3) -----'

Application.ScreenUpdating = False

Set ws_BD2 = Sheets("BD2")
Set ws_BD3 = Sheets("BD3")

'tablo_origine = ws_BD2.Range("D6:E19")

With ws_BD2
Derlgn = .Cells(20, "E").End(xlUp).Row
tablo_origine = .Range(.Cells(6, "D"), .Cells(Derlgn, "E")).Value
End With

x = 0

For Lgn = 1 To UBound(tablo_origine, 1)
FirstDate = DateValue(tablo_origine(Lgn, 1)): LastDate = DateValue(tablo_origine(Lgn, 2))

For Dte = FirstDate To LastDate Step 1
    If IsError(Application.Match(Dte, [BD3_Congés], 0)) Then
        Select Case True
        
            Case Dte = FirstDate
            x = x + 1
            ReDim Preserve tablo_resultat(2, x)
            tablo_resultat(1, x) = Format(Dte, "mm/dd/yy hh:mm")
            tablo_resultat(2, x) = Format(Dte, "mm/dd/yy hh:mm")
            
        End Select
    End If
Next Dte
Next Lgn
 
With ws_BD3
    .Range("D6:E19").ClearContents
    .Cells(6, "D").Resize(UBound(tablo_resultat, 2), UBound(tablo_resultat, 1)) = Application.Transpose(tablo_resultat)
End With
    
End Sub
 

Pièces jointes

  • Transfert Dates.xlsm
    29.5 KB · Affichages: 9
Solution
VB:
Sub test()
    Dim Tablo_origine() As Variant
    Dim Tablo_résultat() As Variant
    Dim Tablo_congés() As Variant
    Dim i As Long, j As Long, k As Long
    Dim WS_BD2 As Worksheet, WS_BD3 As Worksheet
    Const RangeJoursFériés = "D6:E19"
    Const RangeCongés = "D20:E24"
    
    Application.ScreenUpdating = False
    
    Set WS_BD2 = ThisWorkbook.Worksheets("BD2")
    Set WS_BD3 = ThisWorkbook.Worksheets("BD3")
    Tablo_origine = WS_BD2.Range(RangeJoursFériés).Value
    Tablo_congés = WS_BD2.Range(RangeCongés).Value
    ReDim Tablo_résultat(1 To UBound(Tablo_origine, 1), 1 To UBound(Tablo_origine, 2))
    
    k = 0
    For i = 1 To UBound(Tablo_origine, 1)
        For j = 1 To UBound(Tablo_congés, 1)
            If...

Dudu2

XLDnaute Barbatruc
VB:
Sub test()
    Dim Tablo_origine() As Variant
    Dim Tablo_résultat() As Variant
    Dim Tablo_congés() As Variant
    Dim i As Long, j As Long, k As Long
    Dim WS_BD2 As Worksheet, WS_BD3 As Worksheet
    Const RangeJoursFériés = "D6:E19"
    Const RangeCongés = "D20:E24"
    
    Application.ScreenUpdating = False
    
    Set WS_BD2 = ThisWorkbook.Worksheets("BD2")
    Set WS_BD3 = ThisWorkbook.Worksheets("BD3")
    Tablo_origine = WS_BD2.Range(RangeJoursFériés).Value
    Tablo_congés = WS_BD2.Range(RangeCongés).Value
    ReDim Tablo_résultat(1 To UBound(Tablo_origine, 1), 1 To UBound(Tablo_origine, 2))
    
    k = 0
    For i = 1 To UBound(Tablo_origine, 1)
        For j = 1 To UBound(Tablo_congés, 1)
            If Tablo_origine(i, 1) >= Tablo_congés(j, 1) _
            And Tablo_origine(i, 1) <= Tablo_congés(j, 2) Then Exit For
        Next j
        
        If j > UBound(Tablo_congés, 1) Then
            k = k + 1
            Tablo_résultat(i, 1) = Tablo_origine(i, 1)
            Tablo_résultat(i, 2) = Tablo_origine(i, 2)
        End If
    Next i
    
    With WS_BD3
        .Range(RangeJoursFériés).ClearContents
        .Range(RangeJoursFériés).Value = Tablo_résultat
        .Range(RangeJoursFériés).NumberFormat = "dd/mm/yy hh:mm"
    End With
End Sub
 

PMG

XLDnaute Junior
Bonjour Dudu2, le Forum,

Merci @Dudu2 le code marche très bien, j'ai bien compris comment tu as fais.
De mon côté j'avais créé une macro qui extrait toutes les dates comprises entre le début et la fin du tableau congés ("D20:E32") sous forme de colonne ("K5:K34")et que je nomme [BD3_Congés] avec le gestionnaire de noms.

Comment ferais tu pour comparer les valeurs (fériés) du tableau origine à la liste BD3_Congés?
If Tableau_origine(i,1) = [BD3_Congés] Then Exit For

Merci Dudu2 et bonne journée!
PMG
 

Dudu2

XLDnaute Barbatruc
Quant à utiliser le Gestionnaire de noms, le mieux serait d'utiliser des Tableaux Structurés dont les caractéristiques de contenu / taille / position dans la feuille sont gérées à 100% par Excel.
Création: Onglet Accueil / Mettre sous forme de tableau.
Modification: Sélectionner un cellule du tableau puis Onglet Création

Les noms créés par Excel dans le Gestionnaire de noms pour les tableaux structurés sont bien sûr modifiables mais pas les informations sur les tableaux qui restent le monopole d'Excel et c'est normal.

Je reconnais que leur manipulation sous Excel et en VBA est un peu laborieuse mais ça vaut le coup car cela offre une grande souplesse d'utilisation puisqu'on n'a plus à se soucier de la taille et la position des tableaux dans la feuille (sauf leur feuille d'appartenance ce qui est bien dommage).

Edit: grâce à ton test j'ai enfin trouvé une méthode pour ne pas avoir à définir la feuille d'appartenance d'un tableau structuré !

Au lieu de faire:
VB:
Set TblCongés = ThisWorkbook.Worksheets(NomFeuilleTableauCongés).ListObjects(NomTableauCongés)
Il suffit de faire:
Code:
Set TblCongés = [TableauCongés].Parent.ListObjects("TableauCongés")
Ou si on utilise des String (éventuellement issues de constantes) pour nommer les tableaux:
Code:
Const NomTableauCongés = "TableauCongés"
Set TblCongés = Range(NomTableauCongés).Parent.ListObjects(NomTableauCongés)

A noter que dès qu'on utilise des tableaux structurés en VBA on en simplifie l'accès en déclarant et en valorisant une variable ListObject généralement appelée "Tbl" (Dim Tbl as ListObject) qu'on assigné au tableau structuré.

Edit: Un lien pour des infos sur l'utilisation en VBA des tableaux structurés:
 

Pièces jointes

  • Copie de Transfert Dates-1.xlsm
    32.6 KB · Affichages: 4
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla