Discussion :

[largo41]

bonjour a tous je vous explique ce que j'aurais besoin

dans la colonne A le nom des fichiers source (il peut y avoir des noms différents)avec un lien hypertexte

colonne B ref article (toujours diffèrent)

colonne C ref palette (peut y avoir des différence)

colonne D j'indique le nom du client a qui j'attribut cette article

le truc c'est que quand je clic sur modifier le client il ouvre le fichier modifie une ligne referme le fichier et recommence pour la suivante,

et je dois mettre un "X" en colonne F pour qu'il sache qu'el ligne modifier dans le fichier source, j'aimerais plutôt qu'il enregistre quand il y a un nom dans la colonne D

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub Modifier_client()
Dim w As Worksheet, c As Range, i&, client$, lig&, fichier$, cc As Range, n&
Set w = Sheets("Feuil1")
If Application.CountIf(w.[F:F], "X") = 0 Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each c In w.[F:F].SpecialCells(xlCellTypeConstants)
    If UCase(c) = "X" Then
        i = c.Row
        client = w.Cells(i, 4)
        lig = Val(w.Cells(i, 5))
        If lig <= 0 Then
            w.Cells(i, 6) = ""
        Else
            fichier = w.Cells(i, 1).Hyperlinks(1).Address
If Dir(fichier) = "" Then fichier = ThisWorkbook.Path & "\" & fichier
            With Workbooks.Open(fichier).Sheets(1) 'ouvre le fichier
                Set cc = .Cells.Find("AFFAIRE/CLIENT")
                If cc Is Nothing Then
                    w.Cells(i, 6) = ""
                Else
                    n = n + 1
                .Cells(lig, cc.Column) = client
                End If
            .Parent.Close Not cc Is Nothing    'enregistre et ferme le fichier
            End With
        End If
    End If
Next
MsgBox n & " cellule(s) modifiée(s) dans les fichiers sources"
End Sub

enrg1.zip

[EricDgn]

Bonjour,

Pour cela, remplacer ces 2 lignes du code (lignes n° 7 et 8 dans votre message)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
For Each c In w.[F:F].SpecialCells(xlCellTypeConstants)
    If UCase(c) = "X" Then

par ces 2 lignes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
For Each c In w.[D:D].SpecialCells(xlCellTypeConstants)
    If c <> "" Then

mais attention à ne pas laisser trainer des noms.
Personnellement le système des X me semble plus sur.

Cordialement.

[largo41]

merci de ta réponse
effectivement les x était une bonne idée et plus sur ,par contre ca ouvre enregistre et ferme le fichier ligne par ligne
je fais plus de 2500 modification par jour dans diffèrent fichier


j'ai remplacer les 2 ligne comme tu as dit
mais ca na marche pas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub Modifier_client()
Dim w As Worksheet, c As Range, i&, client$, lig&, fichier$, cc As Range, n&
Set w = Sheets("Feuil1")
If Application.CountIf(w.[F:F], "X") = 0 Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each c In w.[D:D].SpecialCells(xlCellTypeConstants)
    If c <> "" Then
        i = c.Row
        client = w.Cells(i, 4)
        lig = Val(w.Cells(i, 5))
        If lig <= 0 Then
            w.Cells(i, 6) = ""
        Else
            fichier = ThisWorkbook.Path & "" & w.Cells(i, 1).Hyperlinks(1).Address
            With Workbooks.Open(fichier).Sheets(1) 'ouvre le fichier
                Set cc = .Cells.Find("AFFAIRE/CLIENT")
                If cc Is Nothing Then
                    w.Cells(i, 6) = ""
                Else
                    n = n + 1
                .Cells(lig, cc.Column) = client
                End If
            .Parent.Close Not cc Is Nothing    'enregistre et ferme le fichier
            End With
        End If
    End If
Next
MsgBox n & " cellule(s) modifiée(s) dans les fichiers sources"
End Sub

il y a cette ligne qui fait allusion au X
je suis vraiment nul en vba

If Application.CountIf(w.[F:F], "X") = 0 Then Exit Sub

je sais pas ce que tu en pense pour eviter importer des lignes déjà attribuer a un client ,c'est peut être dans le code de recherche lui dire d'importer les résultats de la recherche en colonne "S/N et pallet no." que si la cellule de la colonne "affaire/client" et vide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Sub Recherche()
Dim cible$, entete, fso As Object, dossier As FileDialog, sf$, lig&, f As Object, wb As Workbook, plage As Range, col, j%, c As Range, cc As Range, dercol%, i&
cible = "*" & [G1].Text & "*"
entete = Array("S/N", "Pallet No.") 'les 2 colonnes à étudier
Set fso = CreateObject("Scripting.FileSystemObject")
ChDir ThisWorkbook.Path 'dossier initial
Set dossier = Application.FileDialog(msoFileDialogFolderPicker)
If dossier.Show = False Then [B1] = "": Exit Sub
sf = dossier.SelectedItems(1) & "\"
[B1] = sf
Application.ScreenUpdating = False
With Sheets("Feuil1").[A3].CurrentRegion 'nom de la feuille à adapter
    .Offset(1).Delete xlUp 'RAZ
    lig = 2
    For Each f In fso.Getfolder(sf).Files
        Set wb = Workbooks.Open(sf & f.Name) 'ouverture du fichier
        Set plage = ActiveSheet.Range("A1", ActiveSheet.UsedRange)
        ReDim col(1)
        For j = 0 To 1
            Set c = plage.Find(entete(j), , xlValues, xlWhole)
            If c Is Nothing Then MsgBox "En-tête non trouvée dans " & wb.Name: GoTo 1
            col(j) = c.Column
        Next j
        Set cc = plage.Find("AFFAIRE/CLIENT")
        If cc Is Nothing Then dercol = 0 Else dercol = cc.Column
        For i = c.Row + 1 To plage.Rows.Count
            For j = 0 To 1
                If plage(i, col(j)) <> "" Then
                    If plage(i, col(j)).Text Like cible Then
                        .Hyperlinks.Add .Cells(lig, 1), sf & f.Name, TextToDisplay:=f.Name 'lien hypertecte
                        .Cells(lig, 2) = plage(i, col(0))
                        .Cells(lig, 3) = plage(i, col(1))
                        If dercol Then If plage(i, dercol) <> "" Then .Cells(lig, 2).Resize(, 2).Interior.ColorIndex = 6 'jaune
                        Exit For
                    End If
                End If
            Next j
            If .Cells(lig, 1) <> "" Then
                If dercol Then .Cells(lig, 4) = plage(i, dercol)
                .Cells(lig, 5) = i
                lig = lig + 1
            End If
        Next i
1       wb.Close False 'fermeture du fichier
    Next f
    .EntireColumn.AutoFit 'ajustement largeurs
    With .Parent.UsedRange: End With 'actualise la barre de défilement verticale
End With
End Sub

merci a toi

[Philippe Tulliez]

Bonjour,
Si le but est d'accélérer l'exécution de la procédure, je commencerais par trier la colonne A et ensuite ouvrir le classeur et traiter tous les clients de ce classeur avant de le fermer / sauver et passer ensuite au classeur suivant. Cela évitera pas mal d'ouverture/fermeture
Si toutes les lignes ne doivent pas être traitées dans ce cas trier les deux colonnes F & A et ne prendre que les X
Je chargerais également les données en mémoire.

[largo41]

effectivement c'est accélérer la procédure
la partie du code qui effectue une recherche dans la colonne s/n et pallet no. rapporte aussi les résultats de la colonne affaire/client des lignes déjà affecter a un client ,je voudrait qu'il ne rapporte les lignes ou la cellule de la colonne affaire/client et vide

je traite environ 30 fichiers jusqu'a 1000 ligne chacune

je débute en vba mais la je bloque

merci pour ta réponse

[Philippe Tulliez]

Bonjour,
S'il s'agit d'importer des valeurs issues d'autres classeurs peut-être serait-ce plus simple de passer par Power Query mais ne sachant pas exactement ce que vous cherchez à faire, il est difficile d'apporter une réponse pertinente