Problème avec une fonction COMPARER et REMPLACER

[Banosjo]

Bonjour,

J'aurais besoin d'un petit coup de pouce avec une macro. J'ai d'un côté la liste de l'ensemble des fichiers et de l'autre, la liste de certains de ces fichiers (avec des noms de fichiers partiels) qui ont été analysés. Je souhaite intégrer les valeurs calculées des fichiers analysés aux valeurs calculées de l'ensemble des fichiers.

J'arrive malheureusement pas à aligner les bons fichiers et à transposer correctement les donneés.

Pourriez-vous m'aider ? Je joins un fichier d'exemple avec la macro.

Merci d'avance !!

 

[hoerwind]

Re : Problème avec une fonction COMPARER et REMPLACER

Bonjour et bienvenue sur le forum,

Une proposition par formule :

En B4 et à copier vers le bas et vers la droite :

=SI(NB.SI($I$4:$I$7;GAUCHE($A4;11));RECHERCHEV(GAUCHE($A4;11);$I$4:J$7;COLONNE();0);"")

 

[phlaurent55]

Re : Problème avec une fonction COMPARER et REMPLACER

Bonjour à tous,

par macro:

Sub Comparer()

For i = 4 To Range("A65535").End(xlUp).Row
For j = 4 To Range("I65535").End(xlUp).Row
If Left(Cells(i, 1), 11) = Cells(j, 9) Then
Range(Cells(j, 10), Cells(j, 15)).Select
Selection.Copy
Range("B" & i).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Next j
Next i
End Sub

voir fichier joint

à+
Philippe

 

[david84]

Re : Problème avec une fonction COMPARER et REMPLACER

Bonjour à tous, salut Hoerwind, Philippe,

Sub test()
    For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
        For j = 4 To Range("I" & Rows.Count).End(xlUp).Row
            If Left(Cells(i, 1), 11) = Cells(j, 9) Then
                Range(Cells(j, 10), Cells(j, 15)).Copy Destination:=Range(Cells(i, 2), (Cells(i, 7)))
            End If
        Next j
    Next i
End Sub

A+

 

[Banosjo]

Re : Problème avec une fonction COMPARER et REMPLACER

Super, merci !! Je me cassais la tête sur ce problème depuis hier

Précision :

Quand dans mon Ensemble de fichiers je n'ai que 1 fichier, il apparaît sous la forme
8098654_EN_AS_Mgr_Print_Centre.doc (sans le numéro)
et le fichier analysé apparaît sous la forme
8098654

Que devais-je faire pour prévoir cette éventualité ? Avec le "11" de "If Left(Cells(i, 1), 11) = Cells(j, 9) Then", ça ne fonctionne pas ..

Merci de m'éclairer !

 

[phlaurent55]

Re : Problème avec une fonction COMPARER et REMPLACER

Re,

dans ce cas il suffit de remplacer 11 par 7 (8098654 contient 7 caractères)
ou alors il faut déterminer la position du second tiret_bas

à+
Philippe

 

[Banosjo]

Re : Problème avec une fonction COMPARER et REMPLACER

Merci Philippe,

Mais c'est que je dois prévoir les deux possibilités dans la même macro ..

Si j'ai 1 fichier dans mon Ensemble de fichiers alors considérer seulement les 7 premiers caractères, autrement considérer les 11 premier caractères .. Je ne suis pas sûr de la façon d'introduire cette condition dans le code ..

Code :
Sub test()
For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
For j = 4 To Range("I" & Rows.Count).End(xlUp).Row
If Left(Cells(i, 1), 11) = Cells(j, 9) Then
Range(Cells(j, 10), Cells(j, 15)).Copy Destination:=Range(Cells(i, 2), (Cells(i, 7)))
End If
Next j
Next i
End Sub

Merci de votre aide !

 

[Banosjo]

Re : Problème avec une fonction COMPARER et REMPLACER

Re

J'ai finalement trouvé !!

If ActiveSheet.Cells(5, 1).Value <> "" Then
For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
For j = 4 To Range("I" & Rows.Count).End(xlUp).Row
If Left(Cells(i, 1), 11) = Cells(j, 9) Then
ActiveSheet.Range(Cells(j, 10), Cells(j, 15)).Copy
ActiveSheet.Range(Cells(i, 2), (Cells(i, 7))).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Next j
Next i
ElseIf ActiveSheet.Cells(4, 9) <> "" Then
ActiveSheet.Range(Cells(4, 10), Cells(4, 15)).Copy
ActiveSheet.Range(Cells(4, 2), (Cells(4, 7))).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If

Merci beaucoup de votre aide !!