Optimisation de macro
Bonjour à tous,
Dans un de mes fichiers excel, j'utilise cette macro:
Public Sub nb_videsAB()
Dim idd As Long, idr As Long, nbr As Long, tbd
tbd = ActiveSheet.UsedRange.Columns("A").Cells.Value
ReDim tbr(1 To UBound(tbd))
For idd = 1 To UBound(tbd)
If tbd(idd, 1) <> "" Then
If nbr <> 0 Then tbr(idr) = nbr: nbr = 1
idr = idd
ElseIf tbd(idd, 1) = "" Then
nbr = nbr + 1
End If
Next idd
Range("B1").Resize(UBound(tbr), 1).Value = Application.Transpose(tbr)
End Sub
Public Sub nb_videsCD()
Dim idd As Long, idr As Long, nbr As Long, tbd
tbd = ActiveSheet.UsedRange.Columns("C").Cells.Value
ReDim tbr(1 To UBound(tbd))
For idd = 1 To UBound(tbd)
If tbd(idd, 1) <> "" Then
If nbr <> 0 Then tbr(idr) = nbr: nbr = 1
idr = idd
ElseIf tbd(idd, 1) = "" Then
nbr = nbr + 1
End If
Next idd
Range("D1").Resize(UBound(tbr), 1).Value = Application.Transpose(tbr)
End Sub
Public Sub nb_videsEF()
Dim idd As Long, idr As Long, nbr As Long, tbd
tbd = ActiveSheet.UsedRange.Columns("E").Cells.Value
ReDim tbr(1 To UBound(tbd))
For idd = 1 To UBound(tbd)
If tbd(idd, 1) <> "" Then
If nbr <> 0 Then tbr(idr) = nbr: nbr = 1
idr = idd
ElseIf tbd(idd, 1) = "" Then
nbr = nbr + 1
End If
Next idd
Range("F1").Resize(UBound(tbr), 1).Value = Application.Transpose(tbr)
End Sub
Sub VideAtoE()
Call nb_videsAB
Call nb_videsCD
Call nb_videsEF
End Sub
Si l'on prend la 1ère macro (Public Sub nb_videsAB) et la 2ème macro (Public Sub nb_videsCD), seules deux lignes changent: ActiveSheet.UsedRange.Columns("A").Cells.Value devient ActiveSheet.UsedRange.Columns("C").Cells.Value
et Range("B1").Resize(UBound(tbr), 1).Value = Application.Transpose(tbr) devient Range("D1").Resize(UBound(tbr), 1).Value = Application.Transpose(tbr)
Les colonnes vont toujours par deux, la 1ère macro c'est A et B, la 2ème C et D, la 3ème E et F, la 4ème sera G et H etc...
N'y a-t-il pas un moyen de créer une seule et même macro au lieu des trois que j'ai actuellement ?
Car à l'avenir, j'aurai 300 colonnes différentes, soit potentiellement 150 macros !
Merci beaucoup pour votre aide !
Quik
Bonsoir,
une proposition de code non testé :
Public Sub nb_vides(Num_Col)
Dim idd As Long, idr As Long, nbr As Long, tbd
tbd = ActiveSheet.UsedRange.Columns(Num_Col).Cells.Value
ReDim tbr(1 To UBound(tbd))
For idd = 1 To UBound(tbd)
If tbd(idd, 1) <> "" Then
If nbr <> 0 Then tbr(idr) = nbr: nbr = 1
idr = idd
ElseIf tbd(idd, 1) = "" Then
nbr = nbr + 1
End If
Next idd
' ci dessous je n'ai pas testé, à voir si cela marche...
Cells(1, Num_Col + 1).Resize(UBound(tbr), 1).Value = Application.Transpose(tbr)
End Sub
Sub VideAtoE()
For i = 1 To 3 ' reste à mettre en variable la valeur trois
' comme par exemple trouver le nombre de la dernière colonne utilisée
' puis la diviser par deux
Call nb_vides((i * 2) - 1)
Next i
End Sub
L'idée :
une boucle qui lance plusieurs fois le même code mais avec un paramètre dépendant de la valeur de la variable de la boucle, cette valeur calculée correspond au numéro de la première colonne de référence pour le code.
Dans la première ligne d'instruction c'est le numéro "envoyé" qui est utilisé, pour la seconde ligne c'est le numéro de colonne +1
Pas tester, mais l'idée est là...
@ bientôt
LouReeD
Bonjour,
Bonjour LouReed,
Un exemple pour le principe (boucle toutes les 2 colonnes).
Je n'ai pas tout compris du fonctionnement (l'objectif) des macros!...
Cdlt.
Public Sub TEST()
Dim tbl, Arr()
Dim lrow As Long, lCol As Long, k As Long
With ActiveSheet
tbl = .UsedRange.Value
For lCol = LBound(tbl, 2) To UBound(tbl, 2) Step 2
k = 0
For lrow = LBound(tbl) To UBound(tbl)
If tbl(lrow, lCol) <> "" Then
ReDim Preserve Arr(1, k + 1)
Arr(0, k) = tbl(lrow, lCol)
k = k + 1
End If
Next lrow
.Cells(1, lCol).Offset(, 1).Resize(UBound(Arr, 2), 1).Value = Application.Transpose(Arr)
Erase Arr
Next lCol
End With
End Sub
Bonjour LouReeD et Jean-Eric,
Merci pour vos réponses !
LouReed ta solution fonctionne parfaitement, il y a juste le fait que la 1ère doivent être pleine. Est-t-il possible que ta macro commence à fonctionner uniquement dès la 2ème ligne ?
Jean-Eric, une erreur s'affiche lorsque je lance la macro. Je te joint mon fichier
Merci à vous deux !
Quik
Bonsoir,
je viens de tester vos "anciens" codes sur les trois premières paires de colonne, et mon code, sur ces colonnes les résultats sont identiques...
Donc le soucis que vous indiquez vient de votre code, de mon coté je n'ai mis en place que l'option "variable" de votre code.
Excusez moi de pas comprendre votre demande...
@ bientôt
LouReeD
Re,
Oui exactement mais étant pas du tout expert en macro, je vous pose la question à vous pour savoir si vous voyez une solution
Cette macro je l'ai prise de quelqu'un, elle n'est pas de moi et malheureusement je ne la comprend pas totalement !
Merci
Bonjour,
Ta macro revisitée qui boucle toutes les 2 colonnes...
Toujours pas compris l'objectif.
Cdlt.
Public Sub TEST()
Dim tbd, tbr()
Dim idd As Long, lCol As Long, idr As Long, nbr As Long
With ActiveSheet
tbd = .UsedRange.Value
For lCol = LBound(tbd, 2) To UBound(tbd, 2) Step 2
ReDim tbr(1 To UBound(tbd))
For idd = LBound(tbd) To UBound(tbd)
If tbd(idd, lCol) <> "" Then
If nbr <> 0 Then tbr(idr) = nbr: nbr = 1
idr = idd
ElseIf tbd(idd, lCol) = "" Then
nbr = nbr + 1
End If
Next idd
.Cells(1, lCol).Offset(, 1).Resize(UBound(tbr, 1), 1).Value = Application.Transpose(tbr)
Erase tbr
Next lCol
End With
End Sub
Bonjour,
un peu comme Jean-Eric, mais cette fois ci avec le code ci dessous cela devrait correspondre à ce que vous cherchez à faire :
Public Sub nb_vides(Num_Col)
Dim idd As Long, idr As Long, nbr As Long, tbd
tbd = ActiveSheet.UsedRange.Columns(Num_Col).Cells.Value
' ici ajout de la valeur "de départ" de la variable idr
idr = 1
ReDim tbr(1 To UBound(tbd))
For idd = 1 To UBound(tbd)
If tbd(idd, 1) <> "" Then
If nbr <> 0 Then
tbr(idr) = nbr
Else
nbr = 1
' mise "en mémoire" de la première valeur de la première colonne...
tbr(idr) = nbr
End If
idr = idd
ElseIf tbd(idd, 1) = "" Then
nbr = nbr + 1
End If
Next idd
' ci dessous je n'ai pas testé, à voir si cela marche...
Cells(1, Num_Col + 1).Resize(UBound(tbr), 1).Value = Application.Transpose(tbr)
End Sub
Sub VideAtoE()
For i = 1 To 15 ' reste à mettre en variable la valeur trois
' comme par exemple trouver le nombre de la dernière colonne utilisée
' puis la diviser par deux
Call nb_vides((i * 2) - 1)
Next i
End Sub
En fait s'il y avait deux valeurs concécutives sur les deux premières lignes d'une colonne, votre code ignorait la valeur de la première ligne.
J'ai ajouté une définition de valeur de la variable idr à 1 en début de code et mis en mémoire dans le tableau la valeur "1" si le cas se trouvait, c'est à dire nbr=0 donc nbr = 1 et tbr(idr) = nbr où idr=1 à la première boucle grace à sa définition à 1 avant la boucle...
Bref ça à l'air de fonctionner.
@ bientôt
LouReeD
Merci beaucoup à vous deux, c'est tout bon !
Bonsoir,
merci @ vous !
@ bientôt
LouReeD