Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel petites explications sur un code ...

petites explications sur un code ...

9 réponses
Avatar
Patrick
Bonjour à tous,

j'ai vraiment bcp de mal avec les tableaux , bien que je trouve ça
fantastique au niveau vitesse
J'ai repris un code sur le site de J. Boisgontier et je tente de
l'adapter à mon besoin et pour le plaisir de la masturbation
intellectuelle, je tente de comprendre.

Mes questions sont dans le fichier et ça serait sympa de commenter ce
que vous ferez comme modification afin que j'essaye de faire entrer ça
dans ma petite tête :)

Ce genre de chose est souvent demandé dans les forum et là j'essaye de
faire un fichier exemple clair , mais je bute sur des bétises.

Merci
Le fichier est ici

https://www.dropbox.com/s/ypdfmsbu1r7n6h4/oz2007.xlsm?dl=0


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
Signaler un problème avec ce contenu

9 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
DanielCo
Bonjour, Sauf erreur, je trouve ce code plus court :
Option Base 1
Sub test()
Dim Plage As Range, TablVal As Variant, Tabl As Variant, TablAct As
Variant, Result() As String
With Sheets("PRESTATAIRES")
Set Plage = .Range("A2", .Cells(.Rows.Count, 5).End(xlUp))
TablVal = Application.Transpose(Plage.Resize(, 1))
Tabl = Plage.Offset(, 3).Resize(, 2)
End With
With Sheets("REPORT CTR")
TablAct = Application.Transpose(.Range("A3", .Cells(.Rows.Count,
1).End(xlUp)))
ReDim Result(UBound(TablAct), 2)
For i = 1 To UBound(Tabl, 1)
j = Application.Match(Tabl(i, 2), TablAct, 0)
If Tabl(i, 1) = "Station 1" Then
Result(j, 1) = Result(j, 1) & ";" & TablVal(i)
Else
Result(j, 2) = Result(j, 2) & ";" & TablVal(i)
End If
Next i
For i = 1 To UBound(Result, 1)
If Len(Result(i, 1)) > 0 Then Result(i, 1) = Right(Result(i, 1),
Len(Result(i, 1)) - 1)
If Len(Result(i, 2)) > 0 Then Result(i, 2) = Right(Result(i, 2),
Len(Result(i, 2)) - 1)
Next i
.[B3].Resize(UBound(Result, 1), 2) = Result
End With
End Sub
Daniel

Patrick a exposé le 02/11/2015 :
Bonjour à tous,

j'ai vraiment bcp de mal avec les tableaux , bien que je trouve ça
fantastique au niveau vitesse
J'ai repris un code sur le site de J. Boisgontier et je tente de l'adapter à
mon besoin et pour le plaisir de la masturbation intellectuelle, je tente de
comprendre.

Mes questions sont dans le fichier et ça serait sympa de commenter ce que
vous ferez comme modification afin que j'essaye de faire entrer ça dans ma
petite tête :)

Ce genre de chose est souvent demandé dans les forum et là j'essaye de faire
un fichier exemple clair , mais je bute sur des bétises.

Merci
Le fichier est ici

https://www.dropbox.com/s/ypdfmsbu1r7n6h4/oz2007.xlsm?dl=0


---
L'absence de virus dans ce courrier électronique a été vérifiée par le
logiciel antivirus Avast.
https://www.avast.com/antivirus
Avatar
Patrick
Le 2/11/2015 15:16, DanielCo a écrit :
Bonjour, Sauf erreur, je trouve ce code plus court :
Option Base 1
Sub test()
Dim Plage As Range, TablVal As Variant, Tabl As Variant, TablAct As
Variant, Result() As String
With Sheets("PRESTATAIRES")
Set Plage = .Range("A2", .Cells(.Rows.Count, 5).End(xlUp))
TablVal = Application.Transpose(Plage.Resize(, 1))
Tabl = Plage.Offset(, 3).Resize(, 2)
End With
With Sheets("REPORT CTR")
TablAct = Application.Transpose(.Range("A3", .Cells(.Rows.Count,
1).End(xlUp)))
ReDim Result(UBound(TablAct), 2)
For i = 1 To UBound(Tabl, 1)
j = Application.Match(Tabl(i, 2), TablAct, 0)
If Tabl(i, 1) = "Station 1" Then
Result(j, 1) = Result(j, 1) & ";" & TablVal(i)
Else
Result(j, 2) = Result(j, 2) & ";" & TablVal(i)
End If
Next i
For i = 1 To UBound(Result, 1)
If Len(Result(i, 1)) > 0 Then Result(i, 1) = Right(Result(i,
1), Len(Result(i, 1)) - 1)
If Len(Result(i, 2)) > 0 Then Result(i, 2) = Right(Result(i,
2), Len(Result(i, 2)) - 1)
Next i
.[B3].Resize(UBound(Result, 1), 2) = Result
End With
End Sub
Daniel

Patrick a exposé le 02/11/2015 :
Bonjour à tous,

j'ai vraiment bcp de mal avec les tableaux , bien que je trouve ça
fantastique au niveau vitesse
J'ai repris un code sur le site de J. Boisgontier et je tente de
l'adapter à mon besoin et pour le plaisir de la masturbation
intellectuelle, je tente de comprendre.

Mes questions sont dans le fichier et ça serait sympa de commenter ce
que vous ferez comme modification afin que j'essaye de faire entrer ça
dans ma petite tête :)

Ce genre de chose est souvent demandé dans les forum et là j'essaye de
faire un fichier exemple clair , mais je bute sur des bétises.

Merci
Le fichier est ici

https://www.dropbox.com/s/ypdfmsbu1r7n6h4/oz2007.xlsm?dl=0


---
L'absence de virus dans ce courrier électronique a été vérifiée par le
logiciel antivirus Avast.
https://www.avast.com/antivirus




Hello,

oui plus court au niveau temps mais je cherche surtout à comprendre
comment fonctionne celui qui est là pour l'appliquer par la suite; et
avoir une réponse à mes questions :)

merci pour ton code, je vais aussi tenter de le comprendre :)

Patrick


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
Avatar
DanielCo
Hello,

oui plus court au niveau temps mais je cherche surtout à comprendre comment
fonctionne celui qui est là pour l'appliquer par la suite; et avoir une
réponse à mes questions :)

merci pour ton code, je vais aussi tenter de le comprendre :)

Patrick

-pourquoi il dépasse le nombre de lignes défini par :


Last = Range("E65000").End(xlUp).Row
For Each c In Sheets("prestataires").Range("e2:e" & Last)

Qui dépasse ? Comment le vois-tu ?

- pourquoi il refuse le tri ?


Quel est le message d'erreur ?
pourquoi il m'est impossible de redimmensionner ?


Quel est le message d'erreur ?
et pourquoi il ajoute en I7 d'autres ";" ?


A quelle ligne ?
Daniel
Avatar
isabelle
bonjour Patrick,

sur cette ligne,
Last = Range("E65000").End(xlUp).Row
tu ne précise pas la feuille, alors le code va s'appliquer à la feuille active
au moment de l'exécution.
il serait mieux d'écrire
Last = WS1.Range("E65000").End(xlUp).Row

pour le tri, je ne voie pas le problème ?

isabelle
Avatar
Jacquouille
Hello

Je pense, que lorsque Excel se construit un TCD, il reprend "bêtement" le
contenu des cellules, pour aller les recopier dans le Tableau final.
Or, ici, dans les cellules, on a ceci : 10004;10003;10002 ... et tu voudrais
ceci :En B4: 10002;10003;10004
Il ne s'agit pas d'un tri habituel. Excel prend l'info brute et la recopie.

Jacquouille

" Le vin est au repas ce que le parfum est à la femme."
"isabelle" a écrit dans le message de groupe de discussion :
n186es$hcp$

bonjour Patrick,

sur cette ligne,
Last = Range("E65000").End(xlUp).Row
tu ne précise pas la feuille, alors le code va s'appliquer à la feuille
active
au moment de l'exécution.
il serait mieux d'écrire
Last = WS1.Range("E65000").End(xlUp).Row

pour le tri, je ne voie pas le problème ?

isabelle


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
http://www.avast.com
Avatar
Patrick
Le 2/11/2015 18:28, isabelle a écrit :
bonjour Patrick,

sur cette ligne,
Last = Range("E65000").End(xlUp).Row
tu ne précise pas la feuille, alors le code va s'appliquer à la feuille
active au moment de l'exécution.
il serait mieux d'écrire
Last = WS1.Range("E65000").End(xlUp).Row

pour le tri, je ne voie pas le problème ?

isabelle




Hello à tous,
entretemps, j'ai secoué mes neurones (ou ce qu'il en reste )

Juste Isabelle !!!
Je vais le préciser dans mon code ce WS1, merci
Daniel: pour le tri,j'ai trouvé pourquoi il mettait 10001 après 10002 ,
mon code est à présent:
si vide on mets la donnée et le ";" , si pas vide on ajoute la donnée
a(lig, col) = IIf(IsEmpty(a(lig, col)), c.Offset(, -4) & ";", a(lig,
col) & c.Offset(, -4))

En I7 il ajoutait des ";" et là il ne le fait plus.... et il dépassait
le nombre de lignes défini par "LAST" et ne le fait plus, a pas
comprendu, mais ça semble tourner comme ça.

Par contre je ne comprends pas du tout comment dans mon code:
1-
si j'ajoute une activité 6 et 7 ou une station 6, le tableau n'est plus
en ordre à moins de trier l'une des colonnes au préalable dans la
feuille "prestataires"
Est il possible de trier tout ça avec mon code ci-dessous ?
Merci
Sub TableauInverse() ' inspiré d'un code de J. Boisgontier !!!
' http://boisgontierjacques.free.fr/
'
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set ws2 = Sheets("report ctr")
Set ws1 = Sheets("prestataires")
ws2.Range("E1:k10").ClearContents
nblignes = ws1.[e65000].End(xlUp).Row
Dim a(1 To 8, 1 To 8) ' utilité ??? redimmensionnable ?
Dim Last As Long
lig = 1: col = 1
Mlig = lig: Mcol = col
Last = ws1.Range("E65000").End(xlUp).Row
For Each c In Sheets("prestataires").Range("e2:e" & Last)
If d1.exists(c.Value) Then lig = d1(c.Value) Else d1(c.Value) =
Mlig: lig = Mlig: Mlig = Mlig + 1
tmp = c.Offset(, -1)
If d2.exists(tmp) Then col = d2(tmp) Else d2(tmp) = Mcol: col =
Mcol: Mcol = Mcol + 1
a(lig, col) = IIf(IsEmpty(a(lig, col)), c.Offset(, -4) & ";",
a(lig, col) & c.Offset(, -4))
Debug.Print a(lig, col), c.Row, c
Next c
ws2.[f2].Resize(d1.Count, 1) = Application.Transpose(d1.keys)
ws2.[g1].Resize(1, d2.Count) = d2.keys
ws2.[G2].Resize(d1.Count, d2.Count) = a
ws2.Select
End Sub


---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
Avatar
Patrick
Salut Jacques,
ic ce n'est pas un TCD que je connais un peu mais c'est le même principe
sauf que je ne fais pas de décompte ni de totaux :)
Je dois juste cumuler dans une même cellule en séparant par un ";"

°_°

P.

Le 2/11/2015 18:39, Jacquouille a écrit :
Hello

Je pense, que lorsque Excel se construit un TCD, il reprend "bêtement"
le contenu des cellules, pour aller les recopier dans le Tableau final.
Or, ici, dans les cellules, on a ceci : 10004;10003;10002 ... et tu
voudrais ceci :En B4: 10002;10003;10004
Il ne s'agit pas d'un tri habituel. Excel prend l'info brute et la recopie.

Jacquouille

" Le vin est au repas ce que le parfum est à la femme."
"isabelle" a écrit dans le message de groupe de discussion :
n186es$hcp$

bonjour Patrick,

sur cette ligne,
Last = Range("E65000").End(xlUp).Row
tu ne précise pas la feuille, alors le code va s'appliquer à la feuille
active
au moment de l'exécution.
il serait mieux d'écrire
Last = WS1.Range("E65000").End(xlUp).Row

pour le tri, je ne voie pas le problème ?

isabelle


---
L'absence de virus dans ce courrier électronique a été vérifiée par le
logiciel antivirus Avast.
http://www.avast.com





---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus
Avatar
isabelle
bonjour Patrick,

pour redimensionner le tableau à 2 dimensions utilise ReDim Preserve
par exemple

Do While Fichier <> ""
x = x + 1
'--- Redéfinit la taille de la dernière dimension du tableau
ReDim Preserve Tableau(1 To 2, 1 To x)
Loop

il faut aussi savoir que seule la dernière dimension peut être redimensionnée
voir ici pour toute l’information sur les tableaux:
http://silkyroad.developpez.com/vba/tableaux/

isabelle
Avatar
Patrick
Merci :)

P.
voir ici pour toute l’information sur les tableaux:
http://silkyroad.developpez.com/vba/tableaux/

isabelle






---
L'absence de virus dans ce courrier électronique a été vérifiée par le logiciel antivirus Avast.
https://www.avast.com/antivirus