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

[ceddeg]

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]

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

Bonjour ceddeg.

Une première solution:

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]

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]

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]

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]

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