faire matcher " valeurs presentes dans deux feuilles differentes

manulemalin13000 · 7 Janvier 2009

Bonjour a tous,

J ai le fichier en piece jointe qui comporte une macro

Onglet Fluidics:
- colonne B: @52001900779064091509406111134398
Et
- Colonne F le temps qui correspond

Onglet scan:
De toutes ces infos seules 2 m'interessent:
- colonne B: @52001900779064091509406111134398
et
- Le temps qu il y a dessous

Les autres infos ne m'intéressent pas

Ensuite chacune de ces infos est copiée collé dans onglet "calculs"

Et on fait la soustraction des temps

Ce que je n arrive pas a faire:

La soustraction de temps doit s'effectuer QUE SI les deux codes barres dans la feuille fluidics et dans la feuille scan correspondent EXACTEMENT.

En gros la macro de la feuille fluidics va chercher un @52154252 dans la colonne B, regarde si elle retrouve le MEME code barre @52154252 dans la colonne B de la feuille scan et si ces deux codes correspondent elle fait la soustraction des temps qui correspondent a chaque code barre.

Si ils correspondent pas elle fait rien ou met un blanc peu importe

Le soucis c'est que les codes barres n apparaissent pas forcement dans le même ordre entre fluidics et scan

si la macro n'est pas trop complexe a réaliser... ca nous rendrait un grand service et un gain de temps enorme
Merci

manulemalin13000 · 7 Janvier 2009

Re : faire matcher " valeurs presentes dans deux feuilles differentes

J ai trouvé la reponse au cas ou ca interesse qq un

Sub copie()
Dim Cel As Range
Dim Lig As Byte
Lig = 1

Sheets("calculs").Cells.Clear
Sheets("Fluidics").Select
For Each Cel In Range("B1:B" & Range("A65536").End(xlUp).Row)
If Left(Cel, 1) = "@" Then
Cel.Copy Destination:=Sheets("calculs").Range("A" & Lig)
Cel.Offset(-3, 4).Copy Destination:=Sheets("calculs").Range("B" & Lig)
Sheets("calculs").Range("C" & Lig).FormulaR1C1 = "=INDIRECT(""Scan!$B""&MATCH(RC1,Scan!C2,0)+1)"
Sheets("calculs").Range("D" & Lig).FormulaR1C1 = "=RC[-1]-RC[-2]"
Lig = Lig + 1
End If
Next Cel
Sheets("calculs").Range("B1😀" & Lig - 1).NumberFormat = "hh:mm:ss"

End Sub

Pyrof · 8 Janvier 2009

Re : faire matcher " valeurs presentes dans deux feuilles differentes

Bonjour,

Voici une autre méthode

Code:

Sub dudule()
Dim tab1       'Crée une variable
Set tab1 = CreateObject("Scripting.Dictionary")

Sheets("Fluidics").Select
l = 1
ya = 2
While ya <> 0
    tmp = Cells(l, 2)
    If tmp = "" Then
        ya = ya - 1
    Else
        ya = 2
    End If
    If ya > 0 Then
        If Left(tmp, 1) = "@" Then
            tab1(tmp) = Array(Cells(l - 3, 6), "")
        End If
    End If
    l = l + 1
Wend
'--------------------------------------------------
'    feuille scan
'--------------------------------------------------
Sheets("Scan").Select
l = 1
ya = 4
While ya <> 0
    tmp = Cells(l, 2)
    If tmp = "" Then
        ya = ya - 1
    Else
        ya = 4
    End If
    If ya > 0 Then
        If Left(tmp, 1) = "@" Then
            If tab1.exists(tmp) Then
                tmp1 = tab1(tmp)
                tmp1(1) = Cells(l + 1, 2)
                tab1(tmp) = tmp1
            Else
                tab1(tmp) = Array("", Cells(l + 1, 2))
            End If
        End If
    End If
    l = l + 1
Wend

'--------------------------------------------------
'    ecriture resultat
'--------------------------------------------------
Sheets("calculs").Select
l = 10
For Each cle In tab1
    Cells(l, 1) = cle
    tmp1 = tab1(cle)
    Cells(l, 2) = tmp1(0)
    Cells(l, 3) = tmp1(1)
    If tmp1(1) <> "" Then Cells(l, 4) = tmp1(1) - tmp1(0)
    l = l + 1
Next 
End Sub

faire matcher " valeurs presentes dans deux feuilles differentes

manulemalin13000

XLDnaute Occasionnel

Pièces jointes

manulemalin13000

XLDnaute Occasionnel

Pyrof

XLDnaute Occasionnel

Discussions similaires

faire matcher " valeurs presentes dans deux feuilles differentes

manulemalin13000

XLDnaute Occasionnel

Pièces jointes

manulemalin13000

XLDnaute Occasionnel

Pyrof

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency