Faire une boucle avec des numéros de lignes donnés par des variables obtenu
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
Bonjour,
ça irait mieux avec un fichier excel
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
Bonjour,
VBA n'est pas très adapté pour une utilisation avec Libre Office, tu devrais utiliser LibreOffice Basic
Bonjour Patrice
Merci du conseil, je vais m'y atteler.
Cordialement