Faire une boucle avec des numéros de lignes donnés par des variables obtenu

Y compris Writer et toute autre question en lien avec les suites bureautiques Open Source
j
jlduboc66
Jeune membre
Jeune membre
Messages : 16
Inscrit le : 21 avril 2016
Version d'Excel : 2007

Message par jlduboc66 » 20 novembre 2018, 16:02

CDPGF GO automatique 05.ods
(477.82 Kio) Téléchargé 21 fois
Bonjour à tous

Je ne suis pas très expérimenté mais je souhaiterai terminer une application me permettant de créer un devis à partir d'un métré (Feuille "Métrés").

Je récupère sur une feuille "Division" la localisation et les têtes de chapitre et je souhaiterai récupérer les natures d'ouvrages correspondant à chaque tête de chapitre sur une feuille "Ouvrage" dont la plage (Numéros de lignes) est donnée par des variables "x" & "y"

L'ensemble étant à copier sur la feuille "Devis"

J'arrive à traiter la première partie, (copie de la localisation et des chapitres),mais j ne sais pas comment aborder la deuxième (Copie des natures d'ouvrage de chaque tête de chapitre).

Ci après ma macro en cours d'élaboration

Vous en remerciant par avance.

Très cordialement.



SUB Rech_Division()

Dim FL1 As Worksheet, FL2 As Worksheet, Cell As Range, NoCol As Integer, NoLig As Long
Dim DerLig As Long, DerCol As Integer, Var As Variant
Dim J As Long
Dim x As Integer
Dim y As Integer
Dim i As Long
Dim T As Long
Dim Val As Variant
Dim Unit As String
Dim Cprix As String

Set FL1 = Worksheets("Division")
Set FL2 = Worksheets("Ouvrage")

'Détermine la dernière ligne renseignée de la feuille de calculs
DerLig = Split(FL1.UsedRange.Address, "$")(4)

'Détermine la dernière colonne renseignée de la feuille de calculs
DerCol = Columns(Split(FL1.UsedRange.Address, "$")(3)).Column

With ActiveWorkbook.Worksheets("Division")

J = 5

For NoCol = 10 To DerCol

For NoLig = 1 To DerLig

Var = FL1.Cells(NoLig, NoCol)

If Var <> 0 Then

'Enregistrement et copie ligne de titre
If NoLig = 1 Then
Sheets("Division"). Range("D" & NoLig).Value = WorksheetFunction.VLookup(. Cells(NoLig, NoCol).Value, Sheets("Métrés").Range("B2:C13"), 2, False)
Else
Sheets("Division"). Range("D" & NoLig).Value = Range("D" & NoLig)
End If

'Copie de la division sur la feuille devis
T = NoCol + 2 ' Correspond aux numéro de colonne de la feuille "ouvrage"
x = FL1. Range("H" & NoLig).Value ' Variable donnant la 1ère ligne de la plage ou se trouvent les natures d'ouvrages
y = FL1. Range("I" & NoLig).Value ' Variable donnant la dernière ligne de la plage ou se trouvent les natures d'ouvrages
FL1. Range("D" & NoLig).Copy Destination:=Sheets("Devis").Range("B" & j)
Sheets("Devis").Cells(J, 7) = x
Sheets("Devis").Cells(J, 8) = y
Sheets("Devis").Cells(J, 9) = T
J = J + 2

End If

'A partir d'ici, je souhaite aller sur la feuille "Ouvrage" et récupérer avec une boucle, les valeurs non nulles "Val" de chaque colonne "T"
'La désignation de la colonne "H" , "I", "J"
'situés dans la plage délimitée par x et y
' et les copier sur la feuille "Devis"
' Le numéro de colonne "T" de la feuille ouvrage sera T = NoCol + 2

Next NoLig

Next NoCol

Sheets("Devis").Activate
MsgBox "L'enregistrement est terminé", vbInformation

End With

End Sub
Avatar du membre
i20100
Passionné d'Excel
Passionné d'Excel
Messages : 5'120
Appréciations reçues : 270
Inscrit le : 16 mars 2017
Version d'Excel : 2010

Message par i20100 » 23 novembre 2018, 21:17

Bonjour,

ça irait mieux avec un fichier excel :wink:
Merci! de faire un clic sur le bouton résolu pour nous aider à t'aider.
Si vous avez un doute :
annonces/explications-et-regles-a-respecter-t13.html

isabelle
j
jlduboc66
Jeune membre
Jeune membre
Messages : 16
Inscrit le : 21 avril 2016
Version d'Excel : 2007

Message par jlduboc66 » 24 novembre 2018, 16:10

Bonjour

Je n'ai pas Excel, je travaille sur libre office.

Par ailleurs j'ai exploré une piste pour traiter mon problème.

La macro fonctionne mais ne donne pas le résultat escompté.

Ci après la nouvelle macro

SUB Devis()

Dim i As Long
Dim j As Long
Dim DerniereLigne As Integer
Dim Val As Variant
Dim col As long
Dim Unit As String
Dim Cprix As String
Dim Cellule As Range
Dim Loc As Variant

j = 5

'Application.ScreenUpdating = False

Sheets("Ouvrage").Select

With ActiveWorkbook.Worksheets("Ouvrage")
'calcul le nombre de lignes
DerniereLigne = .Range("A1").End(xlDown).Row

col = 12

For col = 12 to 22

i = 1
Do
Val = Cells(i, col).Value
Unit = Range("J" & i).Value
Cprix = Range("I" & i).Value

If Val <> 0 Then

IF I = 1 Then
. Range("H" & i).Value = WorksheetFunction.VLookup(. Cells(i, col).Value, Sheets("Métrés").Range("B2:C13"), 2, False)
Val = 0
Unit = 0
Cprix = o
Loc = Range("H" & i).Value

'Condition si pas de localisation
If Loc = 0 Then
Exit For
End If

Range("H" & i).Copy Destination:=Sheets("Devis").Range("B" & j)

J = J + 2

Else

[b] [Surligner]With ActiveWorkbook.Worksheets("Devis")
Dim plage As Range
Colonne = 2
Set plage = Range(Cells(5, Colonne), Cells(J, Colonne))

Dim c As Range
For Each c In plage
If c.Value <> Sheets("Ouvrage"). Range("D" & i).Value Then
GoTo Line1
End If
Next c[/b][/Surligner]



[Surligner][b] Line1:[/b][/Surligner]
Range("D" & i).Copy Destination:=Sheets("Devis").Range("B" & j)
Sheets("Devis").Range("B" & j).Interior.Color = RGB(174, 240, 194)
Sheets("Devis").Range("B" & j).Font.Name = "Courier"
Sheets("Devis").Range("B" & j).Font.Size = 11

J = J + 2

[Surligner][b] Line2:[/b][/Surligner]
Range("H" & i).Copy Destination:=Sheets("Devis").Range("B" & j)
Sheets("Devis").Range("D" & j) = Val
Sheets("Devis").Range("A" & j) = Cprix
Sheets("Devis").Range("C" & j) = Unit

j = j + 2
End With

End If

End If

i = i + 1

Loop Until i = DerniereLigne

Next COL

End With
sheets("Devis").Activate
MsgBox "L'enregistrement est terminé", vbInformation
End Sub


J'obtiens ça

Maçonneries et cloisons
04.09.03.110 Maçonnerie de brique creuse épais. 0,20 M2 187,5
04.09.08.125 Plus value pour chainage incorporé épaisseur 0.20 M2 75,00
Maçonneries et cloisons
04.09.08.155 Plus value pour linteaux épaisseur 0.20 M2 54,00
04.09.08.195 Plus value pour raidisseurs verticaux anti sismique épaisseur 0.20 M2 102,00

Je souhaite obtenir ceci

Maçonneries et cloisons
04.09.03.110 Maçonnerie de brique creuse épais. 0,20 M2 187,50
04.09.08.125 Plus value pour chainage incorporé épaisseur 0.20 M2 75,00
04.09.08.155 Plus value pour linteaux épaisseur 0.20 M2 54,00
04.09.08.195 Plus value pour raidisseurs verticaux anti sismique épaisseur 0.20 M2 102,00

Je continue à travailler de mon coté.

Cordialement
Avatar du membre
Patrice33740
Membre fidèle
Membre fidèle
Messages : 395
Appréciations reçues : 30
Inscrit le : 27 juillet 2014
Version d'Excel : FR, 2007, 2003, 2013, 2016

Message par Patrice33740 » 24 novembre 2018, 18:27

Bonjour,

VBA n'est pas très adapté pour une utilisation avec Libre Office, tu devrais utiliser LibreOffice Basic
Cordialement
Patrice

Personne ne peut détenir le savoir, c'est pour ça qu'on le partage.
j
jlduboc66
Jeune membre
Jeune membre
Messages : 16
Inscrit le : 21 avril 2016
Version d'Excel : 2007

Message par jlduboc66 » 25 novembre 2018, 10:44

Bonjour Patrice

Merci du conseil, je vais m'y atteler.

Cordialement
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message