XL 2019 suppression de valeur + copie

JeremyLeMalouin · 21 Novembre 2019

bonjour je suis en train de concevoir un tableur pouvant faire des calculs mécaniques en composite, mais avant sa j'aimerais pouvoir en fonction du nombre de plis sélectionner la fibre à utiliser cette partie a été réussi grâce à d'autres discussions sur ce forum. maintenant j'aimerais pouvoir rajouter une âme dans des plis particuliers.

exemple: j'ai 15 plis, je veux mettre une âme aux plis 8, donc je dois remplacer le fibre aux plis 8 par une âme

première partit du code:

Sub automatique()
Dim j As Integer, i As Integer

[E2:E200].ClearContents
[F2:F200].ClearContents
For j = 1 To Range("B65000").End(xlUp)
For i = 2 To Cells(j, 2).Value
Cells(j, 3).Copy Destination:=Range("E" & Range("E65000").End(xlUp).Row + 1)
Cells(j, 4).Copy Destination:=Range("F" & Range("F65000").End(xlUp).Row + 1)
Next i
Next j
End Sub

Staple1600 · 21 Novembre 2019

Bonsoir le fil, Jeremy

Jeremy
De Rennais à Malouin, je me permets une suggestion en passant
En théorie, ta macro ainsi modifiée doit faire la même chose (mais un peu plus rapidement, non ?)

VB:

Sub automatique_B()
Dim j&, i&
Application.ScreenUpdating = False
[E2:F200] = ""
  For j = 1 To Cells(Rows.Count, 2).End(xlUp).Row
      For i = 2 To Cells(j, 2).Value
      Cells(j, 3).Resize(, 2).Copy Cells(Rows.Count, "E").End(3)(2)
      Application.CutCopyMode = False
      Next i
  Next j
End Sub

JeremyLeMalouin · 21 Novembre 2019

bonsoir, Starple
merci d'avoir pris le temps d'améliorer ma macro. en effet celle-ci s’exécute plus rapidement.
Par hasard ne serait tu pas comment lire une valeur dans une cellule et que cette même valeur soit utilisée en tant que coordonner de ligne pour supprimer une case (la colonne est déjà connue)?

et vive la Bretagne

Staple1600 · 21 Novembre 2019

RE

Jemery
Moi c'est Staple, pas Starple

Et la réponse à la question est oui

(et vive les Bretons )

Staple1600 · 21 Novembre 2019

Re

Donc un petit exemple

VB:

Sub Petit_Exemple()
Dim Ligne&, Rng, Q
Randomize
Ligne = Application.RandBetween(1, Asc("Staple") + 1517) 'pour le fun ;-)
Set Rng = Cells(Ligne, "S")
Q = MsgBox("Supprimer la ligne : " & Rng.Row, vbYesNo, "Suppression ligne")
If Q = vbYes Then
Rng.EntireRow.Delete
Else
Exit Sub
End If
End Sub

Staple1600 · 21 Novembre 2019

Re

Un exemple plus simple et qui colle plus à la question

VB:

Sub ExempleII()
Dim Rng As Range
Set Rng = [S1600]
Rng = 15
MsgBox "Valeur dans cellule S1600: " & Rng, vbInformation
MsgBox Cells(Rng.Value, "C").Address(0, 0), vbInformation, "Adresse cellule selon valeur S1600"
Cells(Rng.Value, "C").Interior.Color = vbYellow
MsgBox "Supprimer ligne?"
Cells(Rng.Value, "C").EntireRow.Delete
End Sub

XL 2019 suppression de valeur + copie

JeremyLeMalouin

XLDnaute Nouveau

Pièces jointes

Staple1600

XLDnaute Barbatruc

JeremyLeMalouin

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Discussions similaires