VB, insertion d'une ligne si cellule est supérieure à...

ceddeg · 21 Avril 2016

Bonjour à tous,

Je suis habitué à enregistrer mes macros dans excel, puis les retravailler dans vb.
Mais dans le cas ci-dessous, je coince.

J'ai un tableau en 2 colonnes, la colonne A contient un code, la colonne B une valeur.
Je dois pouvoir créer une macro qui :
Si une valeur dépasse 99, elle crée 2 lignes avec le même code et split les valeurs pour ne pas dépasser 99.
Soit :

Code1 131

Doit devenir

Code1 99
code1 32

Merci d'avance.

ceddeg

thebenoit59 · 21 Avril 2016

Re : VB, insertion d'une ligne si cellule est supérieure à...

Bonjour ceddeg.

Une première solution:

Code:

Option Explicit

Sub Inférieur_100()
Dim i As Integer, c As Variant, a
Dim ShD As Worksheet, ShR As Worksheet
Dim d As Object

Set ShD = Sheets("Données"): Set ShR = Sheets("Résultat désiré")
Set d = CreateObject("Scripting.Dictionary")

With ShD
For i = 1 To .[a65000].End(xlUp).Row
If .Cells(i, 2).Value < 100 Then
d(.Cells(i, 1).Value) = .Cells(i, 2).Value
Else: d(.Cells(i, 1).Value) = 99 & ":" & (.Cells(i, 2).Value - 99)
End If
Next i
End With

With ShR
i = 1
For Each c In d.keys
a = Application.Transpose(Split(d(c), ":"))
.Cells(i, 4).Resize(UBound(a), 1).Value = c
.Cells(i, 5).Resize(UBound(a), 1).Value = a
i = i + UBound(a)
Next c
End With

End Sub

ceddeg · 21 Avril 2016

Re : VB, insertion d'une ligne si cellule est supérieure à...

Merci pour la réponse.
Et rapide en plus.

Mais l'idée n'est pas de créer une autre liste, mais de modifier l'actuelle.

Merci

ceddeg · 21 Avril 2016

Re : VB, insertion d'une ligne si cellule est supérieure à...

Je pense que c'est ok en modifiant ainsi :

Sub Inférieur_100()
Dim i As Integer, c As Variant, a
Dim ShD As Worksheet, ShR As Worksheet
Dim d As Object

Set ShD = Sheets("Données"): Set ShR = Sheets("Résultat désiré")
Set d = CreateObject("Scripting.Dictionary")

With ShD
For i = 1 To .[a65000].End(xlUp).Row
If .Cells(i, 2).Value < 100 Then
d(.Cells(i, 1).Value) = .Cells(i, 2).Value
Else: d(.Cells(i, 1).Value) = 99 & ":" & (.Cells(i, 2).Value - 99)
End If
Next i
End With

With ShD
i = 1
For Each c In d.keys
a = Application.Transpose(Split(d(c), ":"))
.Cells(i, 1).Resize(UBound(a), 1).Value = c
.Cells(i, 2).Resize(UBound(a), 1).Value = a
i = i + UBound(a)
Next c
End With

End Sub

thebenoit59 · 21 Avril 2016

Re : VB, insertion d'une ligne si cellule est supérieure à...

C'est une solution.
A ce moment, évite les balises With en double.
Et au lieu d'écraser les valeurs, effectue plutôt un ClearContents de A1 à B&dernière ligne avant de remettre les valeurs.

ceddeg · 21 Avril 2016

Re : VB, insertion d'une ligne si cellule est supérieure à...

Avec ce code si un cellule contient 201 par exemple
Il me donne une ligne à 99 et une autre à 102. Hors je dois obtenir 3 lignes... 99,99 et 3

VB, insertion d'une ligne si cellule est supérieure à...

ceddeg

XLDnaute Nouveau

Pièces jointes

thebenoit59

XLDnaute Accro

ceddeg

XLDnaute Nouveau

ceddeg

XLDnaute Nouveau

thebenoit59

XLDnaute Accro

ceddeg

XLDnaute Nouveau

Discussions similaires