Bonjour à tous en ce 15 aout : )
Je reprends mon travail de création de sous ensembles et en reprenant le code écrit par job75 il se trouve que je ne fais que me confronter à des messages d’erreur. Au départ j’ai scrupuleusement bien suivi les indications pour modifier les lettres et numéros faisant références aux cellules. Mais plus je cherche où est mon erreur et plus cela devient le capharnaüm.
Ci-joint le fichier
J’ai encore quelques MFC qui trainent sur ce fichier, si elles vous posent problèmes vous pouvez les supprimer mais merci de me le dire. Elles me servent à savoir si les codes et désignations on trop de caractères.
Ne prendre en compte qu’a partir de la ligne 9 sur la page "sous ensemble", les neuf premières lignes correpondent au résultat final que je cherche.
Sur la page « Sous ensemble à exporter » avant exécution de la macro chaque ligne correspond à un « sous ensemble ». Dans les colonnes AN :CU se trouve les codes des « Articles » composant le sous ensemble.
L’idée est de créer les lignes en reprenant un des deux codes de macro écrit par job75
Où d’en réécrire une ou deux en deux temps avec des difficultés supplémentaires.
But de la(où des) macro(s) :
-Créer autant de lignes que d’articles composant un sous ensemble sous chaque sous ensemble puis finir avec une ligne blanche. (Ici une simple correction du code qui fonctionne à l'origine peut suffire)
-Copier les articles sur ces nouvelles lignes crées en colonne B et le code l’article pére(Sous ensemble) en colonne E
-Si possible que cette macro recherche les données équivalant à ces articles (attention ceci dans des feuilles différentes « articles », « opération ». Il est possible mais très rare que des articles n’existent pas auquel cas il faudrait envisager que la ligne de cette article soit rouge)
Les données à rechercher et à copier serait les suivantes désignation en cellule D, famille en cellule F, unité achat en K, prix d’achat en L Date d’achat en M unité de vente en N, prix ht en P, code tva en R, fournisseur en U, référence fournisseur en V, description en W
Pour le matériel en AJ l l’unité en AL et le cout horaire en AM face à « l’opération » correspondante.
-Effacer les données en colonnes AN :CV
J’espère ne rien avoir oublié et vous transmet les deux derniers codes écris par job 75 qui ne comprenait que la première partie de cette nouvelle demande.
Sub Epure()
Dim duree#, deb As Range, ncol%, derlig&, P As Range, i&, j%, n&
duree = Timer
Set deb = [A9:BL9] '1ère ligne à traiter
ncol = deb.Columns.Count 'nombre de colonnes du tableau
derlig = Cells(Rows.Count, deb.Column).End(xlUp).Row
If derlig < deb.Row Then Exit Sub
Set P = deb.Resize(derlig - deb.Row + 1)
Application.ScreenUpdating = False
Application.EnableEvents = False ' si macros évènementielles
Application.Calculation = xlCalculationManual 'si formules volatiles dans le classeur
For i = 1 To P.Rows.Count
For j = ncol - 1 To 40 Step -1 'de BK à AN
If P(i, j) = "" And P(i, j + 1) <> "" Then P(i, j).Delete xlToLeft: n = n + 1
Next j, i
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
MsgBox "Durée " & Round(Timer - duree) & " s" _
& vbLf & vbLf & n & " cellules vides supprimées"
End Sub
Sub InsereLignes()
Dim duree#, deb As Range, ncol%, derlig&, P As Range, rc&, t, tref%(), rest(), i&, n&, j%, n1%
duree = Timer
Set deb = [A9:BL9] '1ère ligne du tableau
ncol = deb.Columns.Count 'nombre de colonnes du tableau
derlig = Cells(Rows.Count, deb.Column).End(xlUp).Row
If derlig < deb.Row Then Exit Sub
Set P = deb.Resize(derlig - deb.Row + 1)
rc = P.Rows.Count
t = P.FormulaR1C1
ReDim tref(1 To UBound(t), 1 To 2) 'au moins 2 éléments
'---tableau des résultats---
ReDim rest(1 To rc + Application.CountA(Range(P.Columns(40), P.Columns(ncol))), 1 To ncol)
For i = 1 To rc
n = n + 1
For j = 1 To ncol
rest(n, j) = t(i, j)
Next
Merci à ceux qui auront lu jusqu'ici et merci par avance à ceux qui apporterons leurs aides/idées bonne soirée
Je reprends mon travail de création de sous ensembles et en reprenant le code écrit par job75 il se trouve que je ne fais que me confronter à des messages d’erreur. Au départ j’ai scrupuleusement bien suivi les indications pour modifier les lettres et numéros faisant références aux cellules. Mais plus je cherche où est mon erreur et plus cela devient le capharnaüm.
Ci-joint le fichier
J’ai encore quelques MFC qui trainent sur ce fichier, si elles vous posent problèmes vous pouvez les supprimer mais merci de me le dire. Elles me servent à savoir si les codes et désignations on trop de caractères.
Ne prendre en compte qu’a partir de la ligne 9 sur la page "sous ensemble", les neuf premières lignes correpondent au résultat final que je cherche.
Sur la page « Sous ensemble à exporter » avant exécution de la macro chaque ligne correspond à un « sous ensemble ». Dans les colonnes AN :CU se trouve les codes des « Articles » composant le sous ensemble.
L’idée est de créer les lignes en reprenant un des deux codes de macro écrit par job75
Où d’en réécrire une ou deux en deux temps avec des difficultés supplémentaires.
But de la(où des) macro(s) :
-Créer autant de lignes que d’articles composant un sous ensemble sous chaque sous ensemble puis finir avec une ligne blanche. (Ici une simple correction du code qui fonctionne à l'origine peut suffire)
-Copier les articles sur ces nouvelles lignes crées en colonne B et le code l’article pére(Sous ensemble) en colonne E
-Si possible que cette macro recherche les données équivalant à ces articles (attention ceci dans des feuilles différentes « articles », « opération ». Il est possible mais très rare que des articles n’existent pas auquel cas il faudrait envisager que la ligne de cette article soit rouge)
Les données à rechercher et à copier serait les suivantes désignation en cellule D, famille en cellule F, unité achat en K, prix d’achat en L Date d’achat en M unité de vente en N, prix ht en P, code tva en R, fournisseur en U, référence fournisseur en V, description en W
Pour le matériel en AJ l l’unité en AL et le cout horaire en AM face à « l’opération » correspondante.
-Effacer les données en colonnes AN :CV
J’espère ne rien avoir oublié et vous transmet les deux derniers codes écris par job 75 qui ne comprenait que la première partie de cette nouvelle demande.
Sub Epure()
Dim duree#, deb As Range, ncol%, derlig&, P As Range, i&, j%, n&
duree = Timer
Set deb = [A9:BL9] '1ère ligne à traiter
ncol = deb.Columns.Count 'nombre de colonnes du tableau
derlig = Cells(Rows.Count, deb.Column).End(xlUp).Row
If derlig < deb.Row Then Exit Sub
Set P = deb.Resize(derlig - deb.Row + 1)
Application.ScreenUpdating = False
Application.EnableEvents = False ' si macros évènementielles
Application.Calculation = xlCalculationManual 'si formules volatiles dans le classeur
For i = 1 To P.Rows.Count
For j = ncol - 1 To 40 Step -1 'de BK à AN
If P(i, j) = "" And P(i, j + 1) <> "" Then P(i, j).Delete xlToLeft: n = n + 1
Next j, i
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
MsgBox "Durée " & Round(Timer - duree) & " s" _
& vbLf & vbLf & n & " cellules vides supprimées"
End Sub
Sub InsereLignes()
Dim duree#, deb As Range, ncol%, derlig&, P As Range, rc&, t, tref%(), rest(), i&, n&, j%, n1%
duree = Timer
Set deb = [A9:BL9] '1ère ligne du tableau
ncol = deb.Columns.Count 'nombre de colonnes du tableau
derlig = Cells(Rows.Count, deb.Column).End(xlUp).Row
If derlig < deb.Row Then Exit Sub
Set P = deb.Resize(derlig - deb.Row + 1)
rc = P.Rows.Count
t = P.FormulaR1C1
ReDim tref(1 To UBound(t), 1 To 2) 'au moins 2 éléments
'---tableau des résultats---
ReDim rest(1 To rc + Application.CountA(Range(P.Columns(40), P.Columns(ncol))), 1 To ncol)
For i = 1 To rc
n = n + 1
For j = 1 To ncol
rest(n, j) = t(i, j)
Next
Merci à ceux qui auront lu jusqu'ici et merci par avance à ceux qui apporterons leurs aides/idées bonne soirée
Dernière édition:
