IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Intersection Ligne colonne et inscription dans (x) Colonnes


Sujet :

Macros et VBA Excel

  1. #1
    Membre régulier
    Profil pro
    Inscrit en
    Août 2006
    Messages
    300
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2006
    Messages : 300
    Points : 107
    Points
    107
    Par défaut Intersection Ligne colonne et inscription dans (x) Colonnes
    Bonjour

    Voilà mon soucis

    Mon tableau sert à la gestion de stock de location.

    Ma Macro se passe comme cela, (Normalement...lol)

    1 - Recherche du code
    2 - Inscription de la quantitée commandée
    3 - Déduction du Stock
    4 - Inscrit la Date de Sortie
    5 - Inscrit la Date du Retour
    6 - Compte le nbre de jour de sortie

    Jusque là ca va ..................

    Je me trouve dans la cellule nbre de jour de sortie sur une ligne (x)

    A partir de là, j'aimerais rechercher la date de sortie (le calendrier commence en (M2)-ou Cells (2,12)

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    TheDate = CDate(C(1, 9)) '(Command.Lab_DatCde)
    With Worksheets("Articles")
    ActiveSheet.Cells(2, 13).Select ' Je ne sais pas si cela est bien utile ????
            Index = Application.Match(TheDate, .Range(.Cells(2, 12), .Cells(2, .Columns.Count)), 0) '
     
            If IsError(Index) Then
     
                MsgBox "Résultat négatif. Rien trouvé.", _
                       vbOKOnly + vbInformation, _
                       "Résultat"
            Else
               .Cells(2, Index).Select 'Sélectionne la date
            End If
    Selectionner la cellule qui se trouve au croisement de ma ligne et de ma colonne, Apartir de cette cellule inscrire le stock disponible a partir de la date de sortie jusqu'à la date de retour.
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    '---------------------------Sélectionne la cellule à l'intersection Ligne/Colonne----------
     
    Set Date_Loc = ActiveCell
    col = Date_Loc.Column
     
    Set Personnel = Range("B5:B1000").Find(Command.TB_Code)
    ligne = Personnel.Row
    Cells(ligne, col).Select
    Application.ScreenUpdating = True
     
     For i = 1 To Temps
    ActiveCell = CDec(C(1, 7))
    ActiveCell.Offset(0, 1).Select
    Next i
     
    End With
    Voilà cela fait plusieurs jours voir semaine que je bloque dessus Si quequ'un avait une idée. Merci d'avance . Je joins le code complet au cas ou.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    Sub location()
    Dim TheDate As Long, Index As Variant
     
    Application.ScreenUpdating = False
    Worksheets("Articles").Activate
    Code = "LCHAP300" 'Code AGLM
    Cde3 = "1" 'Command.TB3 'Valeur de la TB3 de l'USF Command
    DatCde = CDate("04/01/13") 'Command.Lab_DatCde.Caption
    DatRet = CDate("06/01/13") 'Command.Lab_DateRetour.Caption
     
    'If Command.TB3 = "" Then
    'Else
    Worksheets("Articles").Activate
     
        With Sheets("Articles")
                'Chercher son nom dans la feuille Conso colonne B
                Set C = .Range("B2:B" & .Cells(.Rows.Count, 1).End(xlUp).Row).Find( _
                                What:=Code, _
                                After:=.Range("B2"), _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
        Columns(2).Find(Code, , , , , Previous).Select
                C.Value = Code
     
     
            MsgBox "Quantité commandé : " & Cde3
     
            If C(1, 8).Value = "" Then
                C(1, 8) = Cde3 'Nbre ce Chapiteaux Cdé
                C(1, 7).FormulaR1C1 = "=[@[Stock Total]]-[@[Qté Sortie]]" 'DIspo = Stock Total - Qté Sortie
            Else
                C(1, 8) = C(1, 8) + Cde3 'Qté Sortie + Cde en cours
                C(1, 7).FormulaR1C1 = "=[@[Stock Total]]-[@[Qté Sortie]]" 'DIspo = Stock Total - Qté Sortie
            End If
     
     
            If DatCde = "" Then
                Else: C(1, 9) = CDate(DatCde) ' Affiche la Date de Sortie
            End If
     
     
            If DatRet = "" Then
                Else: C(1, 10) = CDate(DatRet) ' Affiche la date Retour
            End If
     
     C(1, 11).Select
     ActiveCell.FormulaR1C1 = _
            "=IF([@[Date de Retour]]="""","""",[@[Date de Retour]]-[@[Date de Sortie]])" ' Nbre de Jour de Loc = Date de Sortie - Date de Retour
      Temps = C(1, 11)
     
    'Recherche Date du début
     
     
    End With
    TheDate = CDate(C(1, 9)) '(Command.Lab_DatCde)
    With Worksheets("Articles")
    ActiveSheet.Cells(2, 13).Select ' Je ne sais pas si cela est bien utile ????
            Index = Application.Match(TheDate, .Range(.Cells(2, 12), .Cells(2, .Columns.Count)), 0) '
     
            If IsError(Index) Then
     
                MsgBox "Résultat négatif. Rien trouvé.", _
                       vbOKOnly + vbInformation, _
                       "Résultat"
            Else
               .Cells(2, Index).Select 'Sélectionne la date
            End If
     
     
    'Fin Call Croisement
    '------------------Recherche la Date du Jour----------------
     
    '---------------------------Sélectionne la cellule à l'intersection Ligne/Colonne----------
     
    Set Date_Loc = ActiveCell
    col = Date_Loc.Column
     
    Set Personnel = Range("B5:B1000").Find(Command.TB_Code)
    ligne = Personnel.Row
    Cells(ligne, col).Select
    Application.ScreenUpdating = True
     
     For i = 1 To Temps
    ActiveCell = CDec(C(1, 7))
    ActiveCell.Offset(0, 1).Select
    Next i
     
    End With
    Application.ScreenUpdating = True
    Worksheets("Planning").Activate
    'End If
    End Sub

  2. #2
    Membre régulier
    Profil pro
    Inscrit en
    Août 2006
    Messages
    300
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Août 2006
    Messages : 300
    Points : 107
    Points
    107
    Par défaut
    J'ai trouvé le problème, la macro était bonne, c'est la mise en forme de ma feuil qui n'allait pas.Merci quand même à ceux qui ce sont intéressé à mon problème.

    Didier

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [XL-2007] Comment supprimer des lignes d'une plage dans une colonne sous condition
    Par capi81 dans le forum Macros et VBA Excel
    Réponses: 9
    Dernier message: 05/06/2015, 12h34
  2. Réponses: 2
    Dernier message: 18/05/2013, 10h14
  3. Insertion ligne vide dans une colonne, mais pas toutes les colonnes.
    Par gsekscor dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 21/04/2013, 23h33
  4. [MySQL] espace dans la colonne des données dans la bdd
    Par davidson81 dans le forum PHP & Base de données
    Réponses: 11
    Dernier message: 27/09/2011, 16h17

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo