Gestion de stock - Problème pour reporter des données automatiquement dans un tableau

[eniotan]

Bonjour à tous,
Je rencontre un problème dans excel pour reporter des données dans un tableau afin de pouvoir gérer un stock d'articles.
J'ai essayé d'utiliser les fonctions Recherchev et les fonctions logiques mais je n'y suis pas parvenu.
J'espère que vous accepterez de m'apporter votre aide sur ce souci.

J'ai à disposition des données sur les évolutions de statut de mes articles. Le tableau est ainsi formé de 3 colonnes : une pour la référence, une pour le statut et la dernière la date à laquelle l'article a changé de statut.

Je souhaiterais pouvoir contrôler les évolutions de stocks. Ainsi, je pensais construire un second tableau à partir du premier pour que le tableau croisé dynamique puisse, derrière compter à chaque date l'état des articles dans les divers statuts.

Ci-joint, le type de données que je récupère. A sa droite se trouve le tableau que je souhaiterais construire automatiquement (ou tout au moins moins laborieusement que tout à la main )

Merci d'avance pour vos lumières !

 

[eniotan]

Re : Gestion de stock - Problème pour reporter des données automatiquement dans un ta

Bonsoir,
Je suis parvenu à mes fins avec deux boucles, ça donne ceci :

Dim i As Integer
Dim j As Integer

For j = 3 To 15
For i = 7 To 21
If (Cells(j, i) <> "" And Cells(j, i + 1) = "") Then
Cells(j, i + 1) = Cells(j, i)
End If
Next
Next

Il ne reste plus qu'à mettre les bonnes bornes pour i et j. j a priori je mettrai un nombre volontairement trop grand car la ligne sera vide donc rien ne s'affichera dans tous les cas. Pour i, je pense placer une cellule qui comptera le nombre de dates avec une fonction type NB.

 

[JBARBE]

Re : Gestion de stock - Problème pour reporter des données automatiquement dans un ta

Le graphique est dans la feuille 3 !

l'ajout de lignes ou de colonnes supplémentaires seront prisent en compte pour la formule NB.SI !

bonne nuit !

 

[Regueiro]

Re : Gestion de stock - Problème pour reporter des données automatiquement dans un ta

Bonsoir Le Forum.
Avec un peu de retard
Bouton LANCE MACRO
Va créer votre tableau automatiquement en dessous du votre ( adaptable )

Option Explicit
Dim Derlig As Long
Dim DerCol As Byte
Dim cell As Range
Sub LANCEMACRO()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
Call Etape1
Call Etape2
Call Etape3
Call Etape4

[E16].Select
    ActiveWorkbook.Names("Extract").Delete

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    End With
End Sub
Sub Etape1()
'Création_Calendrier
Dim Début, Fin As Date
Dim i As Date
Dim cell As Range, li&, col&

Début = Sheets("Feuil1").Range("E2").Value
Fin = Sheets("Feuil1").Range("E3").Value
Set cell = Sheets("Feuil1").Range("F16")
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
li = cell.Row
col = cell.Column
    For i = Début To Fin
        Cells(li, col).Select
                With Selection
                    .Value = i
                   ' .NumberFormatLocal = "jj mmmm aaaa"
                    .NumberFormatLocal = "jj.mm.aaaa"

                    .HorizontalAlignment = xlLeft
                    '.InsertIndent 1
                   ' .Borders.Weight = xlThin
                   .Font.Bold = True
                End With
                col = col + 1
    Next i
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    End With
End Sub
Sub Etape2()
'Copier les valeurs uniques sans doublons du tableau1[Référence]
With ActiveSheet
.Range("Tableau1[Référence]").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ActiveSheet.Range("E16"), Unique:=True
[E16].ClearContents                      'Efface
End With
End Sub
Sub Etape3()
    Dim Zone1 As Range
    Dim cell As Range
    Dim Derlig As Long
    Dim NbLig As Long
    Dim DerCol As Byte
    Dim DLV As Long
    Dim i As Long
    
    'Dernière colonne
    DerCol = Range("F9").End(xlToRight).Column
    'MsgBox DerCol
    
    'Dernière ligne
    Derlig = Range("E17").End(xlDown).Row
    'MsgBox Derlig
    DLV = Range("Tableau1[Référence]").Cells.Find("*", , , , , xlPrevious).Row
    'MsgBox DLV
    
    Set Zone1 = Range("F17", Cells(Derlig, DerCol))
    ActiveWorkbook.Names.Add Name:="Zone1", RefersTo:=Zone1
    'MsgBox Zone1.Address
    
        For Each cell In Zone1
            For i = 2 To DLV

       If Cells(cell.Row, 5).Value = Cells(i, 1) Then
       If CDate(Cells(16, cell.Column).Value) = CDate(Cells(i, 3).Value) Then
       cell.Value = Cells(i, 2).Value
       End If
       End If
       Next i
Next cell
    End Sub
Sub efface()
DerCol = Range("F9").End(xlToRight).Column
Derlig = Range("E17").End(xlDown).Row
With Range("E16", Cells(Derlig, DerCol))
.ClearContents                      'Efface
.Interior.Pattern = xlNone
.HorizontalAlignment = xlLeft
.IndentLevel = 0
End With
End Sub
    Sub Etape4()
    Dim Zone2 As Range
    DerCol = Range("F9").End(xlToRight).Column
    Derlig = Range("E17").End(xlDown).Row
    Set Zone2 = Range("G17", Cells(Derlig, DerCol))

For Each cell In Zone2
    If cell.Value = "" Then
        cell.Value = ""
        cell.FormulaR1C1 = "=RC[-1]"
        cell.Value = cell.Value
    End If
    If cell.Value = 0 Then
    cell.Value = ""
    End If
    
    
    Next cell
End Sub