Se connecter avec
S'enregistrer | Connectez-vous

Besoin d'un coup de main VBA (urgent!!!!)

Dernière réponse : dans Programmation

Bonjour

mon problème est le suivant :  
j'ai 3 feuilles  
feuille 1avec 4 colonnes
 
col1 col2 col3 col4
ref nom quantité date entree
 
feuil2 avec 3 colonnes

col1 col2 col3
ref quantité date sortie
 
feuille 3 est la feuille où je souhaite croiser mes données de la façon suivante :
je veux mettre toutes les réf qui sont dans la feuille 1 et qui sont sorties (c'est à dire date sortie affichée dans la
feuille 2)
 
critère 1: même ref et quantité feuil 1 => quté feuille 2 . dans le cas où qté feuille 1<> qté feuile2 je veux qu'il me marque les deux qtés dans la feuille 3
critère 2 : date entrée <= date sortie pour la meme ref  
 
critère 3: si pas de date de sortie la ligne s'affichera dans la feuille 3 en rouge
 
en gros ma feuille 3 sera :  
 
col1 col2 col3 col4 col 5  
ref nom qté date entrée date sorite

alors j’ai déjà un prog qui fait la chose suivante (code en fin de message)

feuil 1
col1 col2 col3
ref taille date entrée

feuil2
col1 col2 col3
ref taile date sortie

feuille 3 croisement des données :
col1 col2 col3 col4
ref taille date entree date sortie
il croise selon la ref et taille identique et date entrée <= date sortie
le prob que j’ai c'est que je veux ajouter une colonne sur la feuille 1 qui devient col2 où il y a le nom de la réf . et je voudrai qu’il me mette sur la feuille 3 toutes les réf de la feuil1 : si date sortie non affichée , la ligne correspondant à cet ref dans la feuille 3 sera en rouge et si date de sorite affichée il va faire la chose suivante :
si taille feuille 1 >= taille feuille pour la meme réf et si date entrée <= date sortie il me l’écrit
enfin je voudrai que le prog puisse ecrire les deux tailles si différentes dans la colonne taille feuille 3 .

je mets le code que j’ai :


Sub croisementdesdonnees()
Dim F1 As Worksheet, F2 As Worksheet, F3 As Worksheet
Dim TheCel As Range
Dim Tab_F2
Dim xTab As Long
Dim KeyNT As String

Range("A1:C10000").Select
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

'macro pour enregistrer le fichier
'le fichier sera enregistré en ajoutant la date de l'enregistrement

Dim nom As String
nom = Day(Date) & "-" & Month(Date) & "-" & Year(Date) & "_" & ActiveWorkbook.Name
ActiveWorkbook.SaveCopyAs ActiveWorkbook.Path & "\" & nom
rep = MsgBox("Votre base de données est sauvegardée sous le nom : " & nom, vbYes + vbInformation, "Copie sauvegarde classeur")

'init
Set F1 = Sheets("input data")
Set F2 = Sheets("oracle data")
Set F3 = Sheets("résultat")


'recopie le contenu de la feuil1 dans la feuil3
F3.UsedRange.ClearContents
F1.UsedRange.Copy F3.[a1]
F3.[d1] = "date sortie"
F3.[e1] = "cycle time"
F3.[a1] = "Part number"
'On consigne les valeur de la feuil2 dans un tableau
Tab_F2 = F2.UsedRange


'On complete le tableau Feuil3
With F3
For Each TheCel In .Range("A2", .Cells(Rows.Count, "A").End(xlUp))
KeyNT = TheCel & TheCel.Offset(0, 1)
.Range(TheCel, TheCel.Offset(0, 3)).Font.ColorIndex = 0
'on recherche dans le tableauF2
For xTab = 2 To UBound(Tab_F2)
If (Tab_F2(xTab, 1) & Tab_F2(xTab, 2) = KeyNT) And (CDate(Tab_F2(xTab, 3)) >= TheCel.Offset(0, 2)) Then
TheCel.Offset(0, 3) = CDate(Tab_F2(xTab, 3))
GoTo suite
End If
Next
'Si on arrive ici la personne n'est pas sortie
.Range(TheCel, TheCel.Offset(0, 3)).Font.ColorIndex = 3
suite:
Next

Cells(2, 5).FormulaR1C1 = _
"=IF(RC[-1]="""","""",INT(RC[-1]-RC[-2])&""jours""& TEXT(MOD(RC[-1]-RC[-2],1),""[hh]:mm""))"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E2751"), Type:=xlFillDefault
Range("E2:E2751").Select


End With

End Sub

Autres pages sur : besoin coup main vba urgent

Lassé par la pub ? Créez un compte
Lassé par la pub ? Créez un compte