Modif code VBA

Le 09/12/2018 à 23:04

Bonjour

ci dessous un code qui propose d'ouvrir un autre classeur excel mais je veut que ca sera du même classeur

j'ai besoin de modifier le code vba suivant

afin qu'il récupère les info de ce meme classeur de la feuille horaire du format suivant

journée ( type lun , mar ,,,,,) : heure d'arrivé H ; heure de départ

Sub sms()

Dim tabhor()

With Application.FileDialog(msoFileDialogFilePicker)

.AllowMultiSelect = False

.Title = "sélectionnez le fichier planning de la semaine"

.Filters.Clear

.Filters.Add "Excel files", "*.XLS*"

If .Show = True Then

fname = .SelectedItems(1)

Else

MsgBox "no files selected"

Exit Sub

End If

End With

Set wss = ThisWorkbook.Sheets("Feuil1")

Set wsst = ThisWorkbook.Sheets("Feuil2")

wsst.Cells.Clear

dlst = 1

wsst.Cells(1, 1) = "sans N° de téléphone"

wss.Cells(2, 1).Resize(3000, 5).Clear

dls = 1

Set wb = Workbooks.Open(fname)

Set wsp = wb.Sheets("horaire")

Set wst = wb.Sheets("Tel")

dlt = wst.Cells(Rows.Count, 1).End(xlUp).Row

Set plgtel = wst.Cells(2, 1).Resize(dlt - 1, 1)

dlp = wsp.Cells(Rows.Count, 2).End(xlUp).Row

For i = 7 To dlp

ecart = Val(wsp.Cells(i, "U"))

regime = Val(wsp.Cells(i, "S"))

comm = wsp.Cells(i, "V")

'If regime + ecart = 0 And comm <> "CP" Then

' 'exclure

'Else

msg = ""

sep = ""

For j = 23 To 228 Step 34 'col W a col HT

jour = Format(wsp.Cells(4, j), "ddd") & "."

msg = msg & sep & jour & " "

horaire = ""

ReDim tabhor(5, 2)

th = 0

For j1 = 0 To 5 Step 2

If wsp.Cells(i, j + j1) = "" Then Exit For

If wsp.Cells(i, j + j1 + 1) = "" Then horaire = wsp.Cells(i, j + j1): Exit For

th = th + 1

tabhor(th, 1) = wsp.Cells(i, j + j1)

tabhor(th, 2) = wsp.Cells(i, j + j1 + 1)

Next j1

For j1 = 14 To 17 Step 2

If wsp.Cells(i, j + j1) = "" Then Exit For

If wsp.Cells(i, j + j1 + 1) = "" Then MsgBox " horaire de formation invalide en ligne " & i: Exit Sub

th = th + 1

tabhor(th, 1) = wsp.Cells(i, j + j1)

tabhor(th, 2) = wsp.Cells(i, j + j1 + 1)

Next j1

If th > 0 Then

arrangetable tabhor, th

For j1 = 1 To th

horaire = horaire & Format(tabhor(j1, 1), "hh:mm") & "-" & Format(tabhor(j1, 2), "hh:mm") & " "

Next j1

End If

If horaire = "" Then horaire = "OFF"

msg = msg & horaire

sep = vbCrLf

Next j

abcd = wsp.Cells(i, 2)

msg = Replace(msg, ":", "h")

msg = Replace(msg, "h00", "h")

Set re = plgtel.Find(abcd, lookat:=xlWhole, LookIn:=xlValues)

If re Is Nothing Then

f = False

ElseIf re.Offset(, 2) = 0 Then

f = False

Else

f = True

End If

If f = False Then

dlst = dlst + 1

wsst.Cells(dlst, 1) = abcd

wsst.Cells(dlst, 2) = wsp.Cells(i, "I")

wsst.Cells(dlst, 3) = msg

Else

dls = dls + 1

wss.Cells(dls, 1) = re.Offset(, 2)

wss.Cells(dls, 2) = re.Offset(, 1)

wss.Cells(dls, 3) = msg

End If

'End If

Next i

wb.Close False

End Sub

Sub arrangetable(ByRef tabhor, th)

For i = 1 To th - 1

For j = i + 1 To th

If tabhor(i, 1) > tabhor(j, 1) Then

For k = 1 To 2

a = tabhor(i, k)

tabhor(i, k) = tabhor(j, k)

tabhor(j, k) = a

Next k

End If

Next j

Next i

For i = th To 2 Step -1

If tabhor(i, 2) < tabhor(i - 1, 2) Then

If tabhor(i, 1) < tabhor(i - 1, 1) Then

tabhor(i - 1, 1) = tabhor(i, 1)

th = th - 1

Else

th = th - 1

End If

ElseIf tabhor(i, 1) = tabhor(i - 1, 2) Then

tabhor(i - 1, 2) = tabhor(i, 2)

th = th - 1

End If

Next i

End Sub

15macro-1.zip (22.29 Ko)
Le 10/12/2018 à 11:50

Bonjour,

Un essai ... voir si ça convient.

Si ça convient, tu pourras supprimer les lignes que j'ai mises en commentaire.

ric

Le 10/12/2018 à 13:39

Bonjour

merci mais je vois pas le résultat de la macro l'as tu testé stp

Le 10/12/2018 à 14:24

Bonjour,

Tu n'as pas explicité le résultat des opérations du code.

Ce que j'en ai compris en faisant un pas-à-pas (touche F8) > le code efface la "Feuil2" et vient lui réécrire les données des agents 6 à 11.

Feuille "Horaire" ....j'ai copié les plages horaires du Lundi et Mardi dans Mercredi et Vendredi pour m'assurer que les données changeraient dans la "Feuil2".

S'il y a autre chose que je n'ai pas capté > on peut regarder cela ensemble.

ric

Le 10/12/2018 à 14:38

Bonjour

Merci pour ta prise en charge

Voilà le planning se trouve sur la feuille horaire

J’aimerais que Excel me donne un planning dans le même format que déjà existant dans la feuille Feuil1

et 'ai mis aussi un exemple du résultat voulu

si num de tel existe alors il s'affiche sur feuil1

et sur la feuille2 il affiche les planning des agent sans numéro de téléphone

17titooooo-macro-1-7.zip (17.89 Ko)
Le 10/12/2018 à 14:44

Bonjour,

Pour chacun des matricules figurant en colonne A de la feuille horaire ?

Est-ce une feuille par matricules ... si je comprends bien ??

Est-ce bien le traitement que faisait le code en allant lire dans le fichier externe ?

ric

Le 10/12/2018 à 14:57

bonjour

l’ancienne version fessait cela cependant la seule différence au lieu de de demander d'ouvrir un classeur externe casera dorénavant sur le même classeur

cependant autre autre modif du code est necessaire

l’ancien code avant comme source un planning a plusieurs colonne ( plus que 200)

je veut simplifier la chose

horaire du lundi de colonne c jusqu’à F

mardi du g jusqu’à J

mercredi de k jusqu’à N

dimanche de AA jusqu’à AD

et chaque agent posséde bien un Matricule

si c'est rop compliqué le simple fait de rendre la macro récupére le fichier du meme classeur

mais l'idéal c'est de l'avoir avec les modif

1000 merci d'avance

Le 11/12/2018 à 12:30

Bonjour,

Étant donné que je n'ai pas le fichier d'origine pour comprendre ... À quoi correspond :

Ecart, regime et comm ? Sont-ils encore utilisés ?

ecart = Val(wsp.Cells(i, "U"))
regime = Val(wsp.Cells(i, "S"))
comm = wsp.Cells(i, "V")

Aussi, dans ton profil, tu indiques Excel 2007. Y a-t-il une raison particulière pour utiliser le format .xls au lieu de .xlsm ?

ric

Le 11/12/2018 à 13:24

bonjour

oui ils sont tous utilisé je veux juste la seule modif c'est que ca sera plus du fichier externe mais de récupérer les donnée de l'onglet planningcrg ou horaire de toute façon ca je peut la modifier mais l’essentiel c'est l'origine du fichier

Le 11/12/2018 à 14:11

Bonjour,

Pour l'essentiel ... voici ...

Remarque la feuille TEL (écrit Tel dans le code) ... commence en colonne B et dans le code en colonne A.

J'ai modifié pour colonne B. Ce sera à corriger au besoin.

Sub sms()
    Dim tabhor()
    Set wss = ThisWorkbook.Sheets("Feuil1")
    Set wsst = ThisWorkbook.Sheets("Feuil2")
    wsst.Cells.Clear
    dlst = 1
    wsst.Cells(1, 1) = "sans N° de téléphone"
    wss.Cells(2, 1).Resize(3000, 5).Clear
    dls = 1
    Set wsp = ThisWorkbook.Sheets("horaire")
    Set wst = ThisWorkbook.Sheets("TEL")
    dlt = wst.Cells(Rows.Count, "B").End(xlUp).Row      ' était wst.Cells(Rows.Count, 1).End(xlUp).Row
    Set plgtel = wst.Cells(2, "B").Resize(dlt - 1, 1)  ' était wst.Cells(2, 1).Resize(dlt - 1, 1)
    dlp = wsp.Cells(Rows.Count, 2).End(xlUp).Row
    For i = 7 To dlp
        ecart = Val(wsp.Cells(i, "U"))
        regime = Val(wsp.Cells(i, "S"))
        comm = wsp.Cells(i, "V")
        'If regime + ecart = 0 And comm <> "CP" Then
        '    'exclure
        'Else
            msg = ""
            sep = ""
            For j = 23 To 228 Step 34    'col W a col HT
                jour = Format(wsp.Cells(4, j), "ddd") & "."
                msg = msg & sep & jour & " "
                horaire = ""
                ReDim tabhor(5, 2)
                th = 0
                For j1 = 0 To 5 Step 2
                    If wsp.Cells(i, j + j1) = "" Then Exit For
                    If wsp.Cells(i, j + j1 + 1) = "" Then horaire = wsp.Cells(i, j + j1): Exit For
                    th = th + 1
                    tabhor(th, 1) = wsp.Cells(i, j + j1)
                    tabhor(th, 2) = wsp.Cells(i, j + j1 + 1)
                Next j1
                For j1 = 14 To 17 Step 2
                    If wsp.Cells(i, j + j1) = "" Then Exit For
                    If wsp.Cells(i, j + j1 + 1) = "" Then MsgBox " horaire de formation invalide en ligne " & i: Exit Sub
                    th = th + 1
                    tabhor(th, 1) = wsp.Cells(i, j + j1)
                    tabhor(th, 2) = wsp.Cells(i, j + j1 + 1)
                Next j1
                If th > 0 Then
                    arrangetable tabhor, th
                    For j1 = 1 To th
                        horaire = horaire & Format(tabhor(j1, 1), "hh:mm") & "-" & Format(tabhor(j1, 2), "hh:mm") & " "
                    Next j1
                End If
                If horaire = "" Then horaire = "OFF"
                msg = msg & horaire
                sep = vbCrLf
            Next j
            abcd = wsp.Cells(i, 2)
            msg = Replace(msg, ":", "h")
            msg = Replace(msg, "h00", "h")
            Set re = plgtel.Find(abcd, lookat:=xlWhole, LookIn:=xlValues)
            If re Is Nothing Then
                f = False
            ElseIf re.Offset(, 2) = 0 Then
                f = False
            Else
                f = True
            End If
            If f = False Then
                dlst = dlst + 1
                wsst.Cells(dlst, 1) = abcd
                wsst.Cells(dlst, 2) = wsp.Cells(i, "I")
                wsst.Cells(dlst, 3) = msg
            Else
                dls = dls + 1
                wss.Cells(dls, 1) = re.Offset(, 2)
                wss.Cells(dls, 2) = re.Offset(, 1)
                wss.Cells(dls, 3) = msg
            End If
    Next i
End Sub

ric

Le 11/12/2018 à 14:44

bonjour

merci mais j'ai une erreur de script

peut tu envoyer le fichier sur lequel t'as testé la macro

Le 11/12/2018 à 15:21

Bonjour,

C'est le fichier que tu as soumis au début.

Moins les lignes qui faisaient référence au classeur externe.

Plus correction de la colonne en feuille TEL.

Pour détecter les erreurs, est-ce que tu fais du pas-à-pas (touche F8 sur le code)

ric

11titooooo-macro-1a.zip (23.32 Ko)
Rechercher des sujets similaires à "modif code vba"