XL 2010 Explication d'une petite macro

[karakoman1]

Bonjour le forum,

J'ai trouvé sur le net une petite macro qui répartit les données d'une colonne (dans l' exemple de 1000 lignes en 40 colonnes de 25 lignes) que je voudrais pouvoir personaliser selon mes besoins.
Un spécialiste des macros pourrait-il la commenter afin de pouvoir comprendre tout son fonctionnement.

Sub deplac()
Dim Col As Integer
Dim limit As Integer
Dim nbC As Integer limit = 25
nbC = 0
Col = 2 ' colonne B
lig = 0

'On boucle sur les 1000 cellules à partir de la 26eme
For i = limit + 1 To 1000
With ActiveSheet
nbC = nbC + 1
If nbC = limit + 1 Then
nbC = 1
Col = Col + 1
lig = 0
End If
lig = lig + 1
.Cells(lig, Col).Value = .Cells(i, 1).Value
.Cells(i, 1).Value = ""
End With

Next

End Sub

J'aimerais aussi savoir comment:
1 - Comment faire pour pouvoir choisir une autre colonne à scinder de la feuille ou une autre colonne sur une autre feuille.
2 - Est il possible et si oui, comment scinder la colonne suivant une valeur se trouvant dans une cellule plutot que la valeur 25 inscrite dans la macro

Merci d'avance à celui ou celle qui pourra éclairer ma lanterne

 

[Dranreb]

Bonjour.
Essayez peut être comme ça :

Sub Réorganiser()
Dim TSrc(), RngCbl As Range, TCbl(), LSrc As Long, CSrc As Long, LCbl As Long, CCbl As Long
TSrc = Selection.Value
On Error Resume Next
Set RngCbl = Application.InputBox("Destination", Type:=8)
If Err Then Exit Sub
On Error GoTo 0
ReDim TCbl(1 To RngCbl.Rows.Count, 1 To RngCbl.Columns.Count)
LCbl = 1
For LSrc = 1 To UBound(TSrc, 1)
   For CSrc = 1 To UBound(TSrc, 2): CCbl = CCbl + 1
      If CCbl > UBound(TCbl, 2) Then
         CCbl = 1: LCbl = LCbl + 1: If LCbl > UBound(TCbl, 1) Then Exit For
         End If
      TCbl(LCbl, CCbl) = TSrc(LSrc, CSrc): Next CSrc, LSrc
RngCbl.Value = TCbl
End Sub

 

[karakoman1]

Bonjour Dranreb,

Merci de 't'interesser à ma question.
Cepandant, je viens d'essayer la macro ci-dessus, mais visiblement, elle n'a pas l'effet voulu.
De plus, n'étant pas specialiste du VBA, je la comprends encore moins que l'autre
J'ai joint un fichier avec les 2 macros (1 sur chaque feuille) pour comparer les résultats
En fait, une petite explication des différents '"reglages" de la première me suffirait grandement je pense.

Les 2 questions que je me pose avec ma macro, c'est :

1- Par défaut, la macro scinde la colonne A de la feuille active.
Question: Comment on change cette valeur par défaut?
2 - La macro scinde la colonne suivant le nombre de lignes via la ligne de commande
Dim nbC As Integer limit = 25
Question: Est-il possible de modifier la macro pour que cette valeur soit prise via un nombre se trouvant dans une cellule plutot que de devoir le changer manuellement si je veux 30 au lieu de 25 et si oui,, comment?

Merci d'avance

 

[Dranreb]

Le principe d'utilisation de ma macro:
1) — vous sélectionnez la plage source (elle peut ou non comporter déjà plusieurs colonnes)
2) — vous exécutez la macro
3) — vous sélectionnez la plage destinatrice (InputBox), Entrée.
S'il vous faut autre chose, débrouillez vous pour initialiser autrement la variable RngCbl, pareil pour une nouvelle RngSrc, que vous utiliserez dans la macro au lieu de Selection.
Lecture et remplissage: de gauche à droite, puis, arrivé à la dernière colonne, de haut en bas.

 

[karakoman1]

Avec un peu d'explications, c'est vrai qu'elle fonctionne tout de suite mieux
Je vais la tester et la re-tester pour essayer d'autres RngCbl et RngSrc
Mais je reste quand même preneur de commentaires sur les différentes lignes de ma première macro (si jamais).
Un grand merci pour cette macro

 

[karakoman1]

Dranreb,
J'aurais encore une petite dernière question.
Comment fait-on pour avoir les valeurs triées de haut en bas au lieu de, de gauche à droite?

 

[Dranreb]

Ben comme ça , alors:

Sub Réorganiser()
Dim TSrc(), RngCbl As Range, TCbl(), LSrc As Long, CSrc As Long, LCbl As Long, CCbl As Long
TSrc = Selection.Value
On Error Resume Next
Set RngCbl = Application.InputBox("Destination", Type:=8)
If Err Then Exit Sub
On Error GoTo 0
ReDim TCbl(1 To RngCbl.Rows.Count, 1 To RngCbl.Columns.Count)
CCbl = 1
For CSrc = 1 To UBound(TSrc, 2)
   For LSrc = 1 To UBound(TSrc, 1): LCbl = LCbl + 1
      If LCbl > UBound(TCbl, 1) Then
         LCbl = 1: CCbl = CCbl + 1: If CCbl > UBound(TCbl, 2) Then Exit For
         End If
      TCbl(LCbl, CCbl) = TSrc(LSrc, CSrc): Next LSrc, CSrc
RngCbl.Value = TCbl
End Sub

Votre première macro reposait sur un principe tout à fait analogue au remplissage de gauche à droite, sauf qu'elle n'acceptait pas de partir d'une plage de plusieurs colonnes, et surtout, elle aurait été considérablement plus lente sur de grandes plages car elle procédait cellule par cellule au lieu de passer par des tableaux VBA en mémoire.

 

[job75]

Bonsoir karakoman1, Bernard,

Il est sûr que pour aller vite il faut utiliser des tableaux VBA.

Mais ils ne traitent que les valeurs et pas les formats alors que c'est peut-être nécessaire.

Par ailleurs il faut se préoccuper des limites de la feuille, voyez cette macro dans ThisWorkbook :

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Sh.Name = "Résultat" Then Exit Sub
Dim nlig&, limit, ncol, i%, h&
Cancel = True
If Sh.FilterMode Then Sh.ShowAllData 'si la feuille est filtrée
nlig = Cells(Rows.Count, Target.Column).End(xlUp).Row - 1 'nombre de lignes de la colonne
If nlig = 0 Then Exit Sub
'---limite en E1---
With [E1] 'cellule à adapter
  limit = Abs(Int(Val(CStr(.Value))))
  If limit = 0 Then limit = 1
  ncol = Application.RoundUp(nlig / limit, 0)
  If ncol > Columns.Count Then
    limit = Application.RoundUp(nlig / Columns.Count, 0)
    ncol = Application.RoundUp(nlig / limit, 0)
  End If
  .Value = limit
End With
'---tableau des résultats---
With Sheets("Résultat")
  .Cells.Delete 'RAZ
  For i = 1 To ncol
    If i < ncol Then h = limit Else h = nlig - (i - 1) * limit
    Cells(2 + (i - 1) * limit, Target.Column).Resize(h).Copy .Cells(2, i)
    .Cells(1, i) = "Colonne " & i
  Next
  .Rows(1).Font.Bold = True
  .Columns.AutoFit 'ajustement largeur
  With .UsedRange: End With 'ajuste les barres de défilement
  .Activate
End With
End Sub

Fichier joint.

J'ai testé sur une colonne allant jusqu'à la ligne 1048575, scindée par 64 lignes et donnant comme résultat 16384 colonnes.

Alors la macro s'exécute chez moi en 95 secondes.

Ce n'est pas rapide mais on ne lance pas ce genre de macro toutes les 5 minutes...

A+

 

[karakoman1]

Bonsoir Job75, bonsoir le forum
Je viens de tester ta macro qui est excellente, mais malheureusement, je viens de passer des heures à adapter à mon projet celle de Dranreb qui elle aussi est excellente et qui fait très bien son travail.
Je la garde quand même sous le coude, parce que je sens qu'un jour ou l'autre elle me servira.
Merci à vous et aussi à Staple1600 et son humour grinçant qui' m'a également aidé avec une partie du code dans un autre fil. (Sans rancune)
Un grand merci à tous et je vous souhaite une bonne nuit

 

[Staple1600]

Bonsoir le fil, le forum

@karakoman1

Merci à vous et aussi à Staple1600 et son humour grinçant qui' m'a également aidé avec une partie du code dans un autre fil. (Sans rancune)
Un grand merci à tous et je vous souhaite une bonne nuit

Ah bah, tu vois le bout du bout après des semaines du dur labeur
Mais comme disait ma grand-mère: le travail paye toujours

T'as plus qu'à sortir ta raquette!
Balles neuves!

PS: juste pour comprendre, le pourquoi du comment, c'est ici

EDITION: Bonsoir job75

 

[job75]

Re, salut Jean-Marie,

Aucun problème karakoman1 mais je voulais surtout montrer ce que l'on peut faire avec le double-clic et la limite affichée dans une cellule.

Bonne nuit.

 

[karakoman1]

Bonjour Job75,
La limite affichée etait tout à fait ce qu'il me fallait. J'ai fait autrement avec la macro de Dranreb qui fonctionne bien malgré tout, mais je prendrais le temps de modifier mon code pour la remplacer parce que la limite affichée dans une cellule m'ouvrira d'autres possibilités.
Bonne journée à tous