Discussion :

[arctica]

je vous sollicite car j'ai un dossier à faire fonctionner et que je débute en vba
j'ai une 1ere feuille appelée "globale" ayant environ de 3000 à 10000 lignes de données diverses suivant les nombres d'expes dans laquelle la colonne H contient les numéros de départements , et la colonne L contient le nom du transporteur
j'ai une feuille "carte des délais" dans laquelle il y a plusieurs plages nommée d24hr, d48hr, j24hr, j48hr contenant chacune des numéro de départements. et 4 feuilles nommées dhl24, dhl48, joy24, joy48, (total 6 feuilles)
Ce que je souhaiterais c'est que les lignes de la page "globale" contenant un numéro de département ( dans colonne H)appartenant à une des plages dans la feuille "carte des delais" définie par le transporteur colonne L soient copiees dans leurs feuilles de destinations respectives
par exemple
dans la feuille dhl24 on retrouvera toutes les lignes dont les départements appartiennent à la la plage d24hr et dans la feuille dhl48 on retrouvera toutes les lignes dont les département aapartiennent à la plage d48 hr etc de même pour joy48 et joy 24 peut être par le biais de cette formule si(et( gauche (l6;1)="d";nb.si(d24hr;h6);alors transfert vers feuille!dhl24 sinon rien

Merci pour votre aide

[arctica]

Bonjour

voila le fichier en xls

Merci pour votre aide

[mondev]

Salut 'arctica',

Voilà j'ai tenté ça :

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
Private Sub Worksheet_Activate()
 
    Me.Cells.Clear
 
    For Each cellH In ThisWorkbook.Sheets("globale"). _
        Range("H1:" & "H" & Range("H1").End(xlDown).Row).Cells
        For Each cellPlage In Application.Range("d24hr").Cells
            If cellH.Value = cellPlage.Value Then
                cellH.EntireRow.Copy
                If Me.Range("H1").End(xlDown).Row = Me.Rows.Count Then
                    If Me.Range("H1").Value = "" Then
                        Me.Paste Destination:=Me.Range("H1").EntireRow
                        Else
                            Me.Paste Destination:=Me.Range("H2").EntireRow
                    End If
                    Else
                        Me.Paste Destination:=Me.Range("H1"). _
                        End(xlDown).Offset(1, 0).EntireRow
                End If
            End If
        Next cellPlage
    Next cellH
 
    Application.CutCopyMode = False
End Sub

Ca à l'air de bien marcher quand on active la feuille "dhl24", ensuite c'est facile de l'adapter pour les autres feuilles.

Mais le problème c'est qu'il est un peu (trop) lourd ce code, alors si c'est pour l'exécuter qu'une seule fois ça ira, mais là comme il est... !

Si c'est ce que tu cherches, on essayera de l'optimiser.


A toi...

[laetitia]

bonjour arctica mondev le forum j'ai regarde tes fichiers quelque chose m'interpelle dans la feuille "carte des delais" tu as des doublons de chiffres normal pas normal??? de plus dans la meme feuille ta plage est variable ou pas ???
de ("b3 & z")

[arctica]

Bonsoir Laetitia, bonsoir Mondev

en réponse à ta question ,Laetitia, non ce ne sont pas des doublons, chaque plage représente un ensemble de département à livrer par 2 transporteur différents en 24hou 48h

ainsi d24hr est l'ensemble des départements à livrer en 24 par dhl
ainsi d48hr est l'ensemble des départements à livrer en 48 par dhl
j48hr est l'ensemble des départements à livrer en 48 par joyaux
j24hr est l'ensemble des départements à livrer en 24 par joyaux

en tous cas merci pour votre aide

Salut Mondev,

la macro me fait une erreur au départ en me disant:
erreur de compilation,
utilisation incorrecte du mot clé me

qu'est ce que me?

[mondev]

Salut,

"Me" c'est l'objet "dhl24" (la feuille). On peut utiliser ce mot clé pour désigner l'objet "parent".
Donc,
- si tu as copié le code dans le module de la feuille "dhl24", il devrait marcher, sinon,
- si tu l'as copié dans un autre module "standard", remplace :

Code :

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

Me

par

Code :

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

ThisWorkBook.Sheets("dhl24")

et aussi :

Code :

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

Private Sub Worksheet_Activate()

par

Code :

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

Private Sub unNomDeTonChoix()

mais dans ce cas, la procédure ne sera pas exécutée automatiquement.


a+...

[mercatog]

Avec un léger changement de la disposition des données de la feuille "carte des délais", et sans faire appel aux plages nommés, DHL24 en colonne A, DHL48 en colonne B, JOY24 en colonne D, JOY48 en E, JOY72 en colonne F (à partir de la ligne 2)
en plus ceci peut être généralisé au cas où d'autres transporteurs seront ajoutés, ceci à fonctionné:

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
Dim c As Range, plage As Range
Dim LastLig As Long, i As Long
Dim sht As Worksheet, shtb As Worksheet, shtd As Worksheet
Dim typtra As String, typdel As String, namsht As String
Dim ind As Byte
 
Set sht = Worksheets("globale")
Set shtb = Sheets("carte des délais")
LastLig = sht.Range("D65536").End(xlUp).Row
    For i = 6 To LastLig
        typtra = Left(sht.Range("L" & i), 3)
        Select Case UCase(typtra)
            Case "DHL"
                Set plage = shtb.Range("A2:C100")   '3colonnes pour DHL
                ind = 0
            Case "JOY"
                Set plage = shtb.Range("D2:F100")    '3colonnes pour JOY
                ind = 3
            Case Else: Exit Sub
        End Select
        Set c = plage.Find(sht.Range("H" & i).Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            typdel = CStr((c.Column - ind) * 24)
            namsht = "" & LCase(typtra & typdel) & ""
            Set shtd = Sheets(namsht)
            shtd.Rows(shtd.Range("D65536").End(xlUp).Row + 1).Value = sht.Rows(i).Value
        End If
    Next i
 
Set sht = Nothing
Set shtb = Nothing
Set shtd = Nothing

[laetitia]

bonjour arctica mondev mercatog le forum
j' ai pas interprete comme l'ami mercatog je tiens compte de la colonne L de la feuille globale un exemple seulement avec la plage [d24hr] en attendant!!

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
Option Explicit
Dim t As Variant, t2() As String, c As Range, x As Long, i As Long, j As Long, k As Long
Sub es()
    On Error Resume Next
        Application.ScreenUpdating = False
        For Each c In Sheets("carte des délais").[d24hr]
            With Sheets("globale")
                t = .Range("d6:q" & .Range("d65536").End(xlUp).Row)
                x = 1
                For i = 1 To UBound(t)
                    If t(i, 5) = c And t(i, 9) = "DHL3" Then
                        ReDim Preserve t2(1 To 14, 1 To x)
                        For k = 1 To 14
                            t2(k, x) = t(i, k)
                        Next k
                        x = x + 1
                    End If
                Next i
                Sheets("dhl24").Range("a65536").End(xlUp)(2).Resize(UBound(t2, 2), UBound(t2, 1)) = Application.Transpose(t2)
                Erase t, t2
            End With
        Next c
End Sub

[mondev]

Salut tous le monde,

J'ai testé (très vite) les deux codes proposés par 'mercatog' et 'laetitia', ça à l'air de marcher, et beaucoup plus vite qu'avec le mien
Reste plus qu'à choisir

Juste un truc, comme 'mercatog' qui "déteste" les noms des plages, et je le comprends très bien, bah moi j'ai toujours détesté écrire "65536" !

En plus 'arctica', il a Excel 2007, donc 1million de lignes...



Bonne journée

[ouskel'n'or]

Si tu n'aimes pas le Derlig de mercatog, regarde ici ou là, tu trouveras l'une des nombreuses méthodes pour obtenir la dernière ligne renseignée d'une feuille de calculs