récupération de données dans un tableau ne possédant pas les memes abscisses et ordon

lio62

XLDnaute Nouveau
BONSOIR

J'ai une feuille excel "bd" de laquelle je veux extraire les données en fonction du travail fait (depannage entretien ou contrôle) et de la date (moi et année) et qu'il aille recopier les données sur un autre tableau qui comporte
en ligne les années et en colonnes les mois de l'année j'arrive à récupérer les données mais pas a les placer au bon endroit sur le tableau.
je précise que dans la base de données les dates sont sous cette forme (JJ/MM/AAAA)

Code:
Sub stats_TOTO()
Dim i As Integer
Dim regions
Dim Nol As Integer
Dim montableau(3) As String
Sheets("feuil1").Activate
With Application.ActiveSheet
.Range("b1").Value = "MOIS"

montableau(1) = "DEPANNAGE"
montableau(2) = "ENTRETIEN"
montableau(3) = "CONTROLE"

Range("b3:f3").Value = Array("B1", "B2", "B3", "B4", "B5")
 Range("B3:F3").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .Font.Bold = True
        .Interior.ColorIndex = 6
End With
For i = 1 To 3
Cells(i + 3, 1).Value = montableau(i)
Next



'format de cellules
'Range("b4:e7").NumberFormat = "# ##0.00 €"
Range("a7").Value = "TOTAUX"
'nomme les cellules contenant les totaux
'affecte une formule aux cellules nommées
Range("b7").Name = "total1"
Range("total1").Formula = "=sum(b4:b6)"
Range("c7").Name = "total2"
Range("total2").Formula = "=sum(c4:c6)"
Range("d7").Name = "total3"
Range("total3").Formula = "=sum(d4:d6)"
Range("e7").Name = "total4"
Range("total4").Formula = "=sum(e4:e6)"
Range("f7").Name = "total5"
Range("total5").Formula = "=sum(f4:f6)"

End With
Range("A7:F7").Select
With Selection
        .Font.Bold = True
End With
encadrement

Call mois
End Sub

Sub mois()
Dim tabonglet As Variant
Dim onglet As String
Dim n As Long
Dim j As Byte, w As Byte
Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer, f As Integer, g As Integer, h As Integer, r As Integer
Dim DATE1 As Long
Dim DATE2 As Long


Dim rng As Range

tabonglet = Array("DEPANNAGE", "ENTRETIEN", "CONTROLE")
w = 4
For j = 0 To UBound(tabonglet)
Sheets("bd").Activate

onglet = tabonglet(j)
    a = 0
    b = 0
    c = 0
    d = 0
    e = 0
    f = 0
    g = 0
    h = 0
        DATE1 = (Year([ao1])) + Month([ao1])
        
    With Worksheets("bd")
        .Range("a2").Activate
        .Range("a2").End(xlDown).Select
        Set rng = ActiveCell
        For n = 2 To rng.Row
    DATE2 = (Year(.Range("b" & n))) + Month(.Range("b" & n))

            If .Range("a" & n) = onglet And .Range("x" & n) Like "B1" And DATE1 = DATE2 Then a = a + 1
            If .Range("a" & n) = onglet And .Range("x" & n) Like "B2" And DATE1 = DATE2 Then d = d + 1
            If .Range("a" & n) = onglet And .Range("x" & n) Like "B3" And DATE1 = DATE2 Then b = b + 1
            If .Range("a" & n) = onglet And .Range("x" & n) Like "B4" And DATE1 = DATE2 Then c = c + 1
            If .Range("a" & n) = onglet And .Range("x" & n) Like "B5" And DATE1 = DATE2 Then g = g + 1
            'If .Range("av" & n) Like "*melor*" Then d = d + 1
            'If .Range("av" & n) Like "*melec*" Then e = e + 1
            'If .Range("av" & n) Like "*melim*" Then f = f + 1
            'If .Range("av" & n) Like "*melimpa*" Then g = g + 1
             
        Next n
        Sheets("feuil1").Range("b" & w) = a   ' 
        Sheets("feuil1").Range("c" & w) = d   ' 
        Sheets("feuil1").Range("d" & w) = b   ' 
        Sheets("feuil1").Range("e" & w) = c  ' 

         Sheets("feuil1").Range("f" & w) = g   '
              
        
        w = w + 1
    End With
Next j

Worksheets("bd").Range("S1").Activate
End Sub


     Sub encadrement()
     Dim i As Integer
    ThisWorkbook.Names("plage1").RefersToRange.Select
     For i = 1 To 4: Selection.Borders(i).LineStyle = xlContinuous: Next i
     End Sub
 

Sub annuel_rav()
Dim i As Integer, j As Integer

'Dim regions
'Dim Nol As Integer
Dim montableau(12) As String
Sheets("feuil1").Activate
With Application.ActiveSheet
.Range("b10").Value = "DEPANNAGE"

montableau(1) = "janvier"
montableau(2) = "février"
montableau(3) = "mars"
montableau(4) = "avril"
montableau(5) = "mai"
montableau(6) = "juin"
montableau(7) = "juillet"
montableau(8) = "août"
montableau(9) = "septembre"
montableau(10) = "octobre"
montableau(11) = "novembre"
montableau(12) = "décembre"


Range("b12:g12").Value = Array("2005", "2006", "2007", "2008", "2009", "2010")
 Range("B12:g12").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .Font.Bold = True
        .Interior.ColorIndex = 43
End With
For i = 1 To 12
Cells(i + 12, 1).Value = montableau(i)
Next



'format de cellules
'Range("b4:e7").NumberFormat = "# ##0.00 €"
Range("a25").Value = "TOTAUX"
'nomme les cellules contenant les totaux
'affecte une formule aux cellules nommées
Range("b25").Name = "total11"
Range("total11").Formula = "=sum(b13:b24)"
Range("c25").Name = "total21"
Range("total21").Formula = "=sum(c13:c24)"
Range("d25").Name = "total31"
Range("total31").Formula = "=sum(d13:d24)"
Range("e25").Name = "total41"
Range("total41").Formula = "=sum(e13:e24)"
Range("f25").Name = "total51"
Range("total51").Formula = "=sum(f13:f24)"
Range("g25").Name = "total61"
Range("total61").Formula = "=sum(g13:g24)"
End With
Range("A25:g25").Select
With Selection
        .Font.Bold = True
End With
    ThisWorkbook.Names("plage2").RefersToRange.Select
     For j = 1 To 4: Selection.Borders(j).LineStyle = xlContinuous: Next j
     

'Call mois


End Sub

Sub annee_DEPANNAGE()
Dim tabonglet As Variant
Dim tabonglet2 As Variant
Dim onglet As String
Dim onglet2 As String
Dim n As Long
Dim j As Byte, w As Byte ', k As Byte

Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer, f As Integer, g As Integer, h As Integer, r As Integer
Dim DATE1 As Long
Dim DATE2 As Long
'Dim date3 As Long


Dim rng As Range
tabonglet = Array("DEPANNAGE")
w = 13
For j = 0 To UBound(tabonglet)

Sheets("bd").Activate

onglet = tabonglet(j)
    a = 0
    b = 0
    c = 0
    d = 0
    e = 0
    f = 0
    g = 0
    h = 0
        DATE1 = (Year([ao1])) + Month([ao1])
        
    With Worksheets("bd")
        .Range("a2").Activate
        .Range("a2").End(xlDown).Select
        Set rng = ActiveCell
        For n = 2 To rng.Row
 DATE2 = (Year(.Range("b" & n))) + Month(.Range("b" & n))
          


            If .Range("a" & n) = onglet And DATE1 = DATE2 Then a = a + 1
                                 
        Next n
        'For k = 0 To (tabonglet2)
        'onglet2 = tabonglet2(k)
'tabonglet2 = Array("janvier", "février", "mars", "avril", "mai", "juin", "juillet", "août", "septembre", "octobre", "novembre", "décembre")


        Sheets("feuil1").Range("d" & w) = a  ' 2007
       ' Sheets("feuil1").Range("c" & w) = d   ' onduleur
       ' Sheets("feuil1").Range("d" & w) = b   ' imprimante
        'Sheets("feuil1").Range("e" & w) = c  ' imprimante partage
        ' Sheets("feuil1").Range("f" & w) = g   '
        'Sheets("feuil1").Range("c18") = d
        'Sheets("feuil1").Range("d18") = e
        ''Sheets("feuil1").Range("e18") = f
        'Sheets("feuil1").Range("f18") = g
       
        
        w = w + 1
    End With
   
Next j
 'Next k
Worksheets("bd").Range("S1").Activate
End Sub

merci a+
 

Pierrot93

XLDnaute Barbatruc
Re : récupération de données dans un tableau ne possédant pas les memes abscisses et ordon

Bonsoir Lio

Quelle est la question ? Tu bloques quelque part dans ton code ?

Peut être qu'un fichier en pièce jointe nous aiderait à t'aider.

bonne soirée
@+
 

jeanpierre

Nous a quitté
Repose en paix
Re : récupération de données dans un tableau ne possédant pas les memes abscisses et ordon

Bonsoir lio62, le forum,

Ton code est bien... pas analysé, mais hors de son contexte, c'est pas vraiment simple.

Un petit fichier joint de ton souci et avec ce code serait plutôt bien...

Bonne soirée.

Jean-Pierre

Edit : Oh là, salut Pierrot, faut vraiment pas être déranger.....
 
Dernière édition:

lio62

XLDnaute Nouveau
Re : récupération de données dans un tableau ne possédant pas les memes abscisses et ordon

BONJOUR,

j'ai joint le fichier, pour infos on lance par le module stat et c'est le dernier module "MAINTENANCE" qui me pose souci je voudrais récupérai les données de la feuille BD et qu'il me les recopie dans le tableau MAINTENANCE de la feuil1, au bon endroit. (dans l'exemple en FEVRIER 2007)

tout en sachant qu'il y aura deux autres tableaux DEPANNAGE et CONTROLE en dessous.

merci a+
 

Pièces jointes

  • FCDNDOWN2.zip
    42.2 KB · Affichages: 26

lio62

XLDnaute Nouveau
Re : récupération de données dans un tableau ne possédant pas les memes abscisses et ordon

bonjour Pierrot, bonjour Jeanpierre

j'ai joins le fichier avez vous reussi a l'ouvri? car il est compressé avec winrar également

merci a+
 

Discussions similaires

Réponses
0
Affichages
83

Statistiques des forums

Discussions
311 709
Messages
2 081 779
Membres
101 816
dernier inscrit
Jfrcs