Mettre à jour un tableau excel

[plonglet]

Bonjour,

Grâce au code VBA ci-dessous le numéro d'affaires inséré ouvre le classeur souhaité, va chercher les valeurs recherchées puis les insères dans la case choisit.

Le soucis c'est que ces données peuvent être modifiées et que mon classeur ne prend pas en compte ces modifications.


Le problème étant le suivant :
-si les valeurs changent après avoir entrée le numéro d'affaire, ces valeurs ne sont pas actualisées.
-il faut alors effacer et réécrire le numéro d'affaire pour retourner lire le tableau et ainsi de suite ...

Je voudrais donc savoir si on peut à l'aide d'une macro permettre un calcul automatique

Merci

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Target.Column = 1 Then Exit Sub ' Ne réagir que si elle est située dans la première colonne
If IsEmpty(Target) Then Exit Sub ' Ne pas lancer la procédure lorsqu'on efface une cellule
If Not IsNumeric(Target) Then Exit Sub ' Ne réagir qu'à la saisie d'un numéro d'affaire
Debug.Print Target

' On dispose donc ici du numéro d'affaire
' Il reste à parcourir le document "Planning Montage.xls" pour trouver les données relatives à cette affaire et à les reporter en face
Dim w, planning As Workbook
For Each w In Application.Workbooks
If w.Name = "Planning Montage.xls" Then Set planning = w
Next w
If planning Is Nothing Then
'Le document n'était pas ouvert, donc il faut l'ouvrir
Application.Workbooks.Open Application.ActiveWorkbook.Path & "\" & "Planning Montage.xls"
Set planning = Workbooks("Planning Montage.xls")
End If

Dim planningSheet As Worksheet, r As Range, c As Range, premièreLigne As Integer, dernièreLigne As Integer
Dim semaineDébut As Integer, semaineFin As Integer
Set planningSheet = planning.Sheets("Planning")
Set r = planningSheet.Columns("A:A")

Set c = r.Find(What:=Target.Value, LookIn:=xlValues)
If c Is Nothing Then Exit Sub

' On ne travaille que si on a trouvé le n° d'affaire
' On va rechercher toutes les lignes qui comporte ce numéro d'affaire en colonne 1
premièreLigne = c.Row
Do
TrouverBornes c, semaineDébut, semaineFin
dernièreLigne = c.Row
Set c = r.FindNext(c)
Loop While Not c Is Nothing And c.Row <> premièreLigne

' On dispose maintenant des numéros de colonne dans lesquelles l'affaire commence (semaineDébut)
' et finit (semaineFin). Il reste à aller récupérer les numéros de semaine corresondants
' Ceux-ci se trouvent sur la ligne 1 du planning

semaineDébut = planningSheet.Cells(1, semaineDébut + 1)
semaineFin = planningSheet.Cells(1, semaineFin + 1)
Debug.Print semaineDébut, semaineFin

' Il ne reste plus qu'à les reporter à côté de la cellule dans laquelle on a tapé le numéro d'affaire
Target.Offset(0, 2) = semaineDébut
Target.Offset(0, 3) = semaineFin
' Attention : si on commence en semaine 4 et qu'on finit en semaine 8, il me semble que la durée est de 5 semaines
' et non de 4 comme vous l'avez indiqué dans votre document
' D'où le +1 final
' On ajoute 52 à tout cela pour permettre les calculs de durée avec un début en semaine 51 et la fin en semaine 2 par exemple
Target.Offset(0, 4) = (52 + semaineFin - semaineDébut + 1) Mod 52


Private Sub TrouverBornes(c As Range, ByRef semaineDébut As Integer, ByRef semaineFin As Integer)
Dim sem1 As Integer, sem2 As Integer
Dim i As Integer
i = 10
Do While i < 62
If IsNumeric(c.Offset(0, i)) And c.Offset(0, i) > 0 Then
If semaineDébut = 0 Or i < semaineDébut Then semaineDébut = i
If i > semaineFin Then semaineFin = i
End If
i = i + 1
Loop
End Sub

 

[Staple1600]

Re : Mettre à jour un tableau excel

Bonjour plonget, les gens du fil & du forum

Une suggestion au passage
Pour rendre la lecture de ton message plus agréable, tu peux utiliser les balises BB code
sur le code VBA inclu dans celui-ci.
• voir ici pour les détails : Balises BB et plus précisément ici: CODE

Tu peux aussi utiliser lors la rédaction de ton message, la fonctionnalité suivante de l'éditeur
Tu sélectionnes le code VBA et tu clique sur

)
Exemple du résultat obtenu :

Private Sub TrouverBornes(c As Range, ByRef semaineDébut As Integer, ByRef semaineFin As Integer)
    Dim sem1 As Integer, sem2 As Integer
    Dim i As Integer
    i = 10
    Do While i < 62
        If IsNumeric(c.Offset(0, i)) And c.Offset(0, i) > 0 Then
            If semaineDébut = 0 Or i < semaineDébut Then semaineDébut = i
            If i > semaineFin Then semaineFin = i
        End If
        i = i + 1
    Loop
End Sub