probleme de recherche de noms

antonio71

XLDnaute Nouveau
bonjour à tous

voilà mon pb

j'ai un fichier avec des références et nous sommes 3 inspecteurs voir 4 plus tard à nous partager les tâches !
sur les colonnes de droites se trouvent le calendrier du 1er semestre et nous cochons notre trigramme dans la cas sorrespondant au jour de l'inspection et en face la ligne des produits à aller contrôler
j'aimerai savoir comment faire pour que rapidement je puisse par trigramme savoir à qui le controle est attribué pour quels produits et quand !!

je joinds le fichier
en vous en remerciant par avance
SA
 

Pièces jointes

  • QI07 planing inspections .zip
    37.6 KB · Affichages: 45

PMO2

XLDnaute Accro
Re : probleme de recherche de noms

Bonjour,

Je ne suis pas sûr d'avoir compris votre demande.
A tout hasard, j'ai programmé le code suivant :

Code:
Const FEUILLE As String = "Planning Inspections"
Sub AttributionTrigramme()
Dim S As Worksheet
Dim R As Range
Dim var
Dim lastLig&
Dim i&
Dim j&
Dim k&
Dim cpt&
Dim T()
Dim bool As Boolean

Set S = Sheets(FEUILLE)
lastLig& = S.[a65536].End(xlUp).Row
var = S.Range("a1:iv" & lastLig& & "")
For i& = 7 To lastLig&
  For j& = 11 To 256
    If Trim(var(i&, j&)) <> "" Then
      cpt& = cpt& + 1
      ReDim Preserve T(1 To 4, 1 To cpt&)
      T(1, cpt&) = Trim(var(i&, j&))
      T(2, cpt&) = Trim(var(i&, 3))
      T(3, cpt&) = Trim(var(i&, 4))
      If var(1, j&) <> "" Then
        T(4, cpt&) = Trim(var(4, j&)) & Space(1) & Trim(Format(var(1, j&), " mmm yyyy"))
      Else
        bool = False
        k& = 1
        Do
          If var(1, j& - k&) <> "" Then
            T(4, cpt&) = Trim(var(4, j&)) & Space(1) & Trim(Format(var(1, j& - k&), " mmm yyyy"))
            bool = True
          End If
          k& = k& + 1
        Loop Until bool
      End If
    End If
  Next j&
Next i&
Set S = Sheets.Add(after:=Sheets(Sheets.Count))
var = Array("Inspecteur", "Article", "Désignation", "Date")
Set R = S.Range(S.Cells(1, 1), S.Cells(1 + 1, UBound(T, 1)))
R = var
Set R = S.Range(S.Cells(2, 1), S.Cells(UBound(T, 2) + 1, UBound(T, 1)))
R = Application.WorksheetFunction.Transpose(T)
End Sub

Faites un essai en lançant la macro "AttributionTrigramme".

Cordialement.

PMO
Patrick Morange
 

PMO2

XLDnaute Accro
Re : probleme de recherche de noms

Bonjour,

J'ai supposé que ce que vous appelez "numero de commande" est "Doc achat".
Si c'est bien le cas alors voici, en pièce jointe, le code modifié.

Cordialement.

PMO
Patrick Morange
 

Membres actuellement en ligne

Statistiques des forums

Discussions
312 305
Messages
2 087 084
Membres
103 459
dernier inscrit
Arnocal