Code VBA - transformation des donnees dans une colonne en trois colone
m
Bonjour,
Toutes les données sont placées et alignés dans une colonne mais il devrait y avoir en 3 colonnes, comment les convertir en 3 trois colonnes (NUM/DESIGNATION/CODE)
Très simple :
- vous supprimez les 3 lignes parasites : 185, 306 et 693
- puis vous appliquez la petite macro suivante :
Option Explicit
Sub Separation()
Dim wS1 As Worksheet, wS2 As Worksheet
Dim i As Integer, ligne As Integer
Set wS1 = Sheets("tableau")
Set wS2 = Sheets("Traitement")
ligne = 1
For i = 2 To 1998 Step 3
ligne = ligne + 1
wS2.Cells(ligne, 1) = wS1.Cells(i, 1)
wS2.Cells(ligne, 2) = wS1.Cells(i + 1, 1)
wS2.Cells(ligne, 3) = wS1.Cells(i + 2, 1)
Next i
End SubBonjour à tous,
Une petite variante...
Sub test()
Dim tb, ntb(), i&, k&, titres, j%
Dim start As Single '(optionnel)
tb = Sheets("tableau").Range("A2").CurrentRegion 'tableau de valeurs
titres = Array("Num", "Désignation", "Code") '........tableau des titres
start = Timer '......................................chrono (optionnel)
Application.ScreenUpdating = False '..................désactive rafraichissement de l'écran
k = 0 '...............................................indice de départ tu tableau ntb
ReDim Preserve ntb(1 To UBound(tb, 1), 1 To 3) '......dimensionne ntb
For i = 2 To UBound(tb, 1) Step 3 '..................boucle sur les lignes de tb avec un pas de 3
On Error Resume Next '..............................si une erreur est générée, on l'ignore
ntb(k + 1, 1) = tb(i, 1) '.........................première colonne ntb=ligne de tb (en fonction de i)
ntb(k + 1, 2) = tb(i + 1, 1) '.....................deuxième colonne ntb=ligne +1 de tb
ntb(k + 1, 3) = tb(i + 2, 1) '.....................troisième colonne ntb=ligne +2 de tb
k = k + 1 '........................................incrémente l'indice
On Error GoTo 0
Next i
With Sheets("traitement") '...........................agit sur cette feuille uniquement
.Cells.Delete '.......................................efface toutes les données
For j = LBound(titres) To UBound(titres) '...........boucle sur le tableau titres
.Cells(1, j + 1) = titres(j): .Cells(1, j + 1).Font.Bold = True 'inscrit les titres à partir de A1 en gras
Next j
.Range("A2").Resize(k, 3) = ntb '.....................inscrit les valeurs de ntb à partir de A2
.Columns.AutoFit '....................................adapte la largeur des colonnes
.Activate '...........................................active la feuille
End With
Erase tb: Erase ntb '..................................vide la mémoire
MsgBox "durée du traitement: " & Timer - start & " secondes" 'message(optionnel)
End SubCTRL + e pour exécuter la macro test
Cordialement,
Mikalo a dû jeter son ordi par la fenêtre.
Blacklist+1.
J