Nettoyer et transformer matrice NxM en une matrice PxL, P pouvant varier

[Circark]

Bonsoir à toutes et tous

J'ai une grande quantité de données à traiter et j'ai besoin de transformer une sélection de données (Matrice N x M) en une matrice (ou tableau) P x L avec un nombre de colonnes P déterminé par la valeur d'une cellule (dans mon cas la cellule E4).

J'ai songé utiliser la fonction TRANSPOSE, mais je n'ai rien trouvé de satisfaisant (à savoir influer sur le nombre de colonnes de ma matrice). Ce que je cherche à faire:

1/ Dans la sélection actuelle (tableau ci-joint, zone sélectionnée avec la souris, ici tableau D7:S37), ne garder que les nombres (supprimer les autres caractères qui ne sont pas de nombres positifs ou négatifs, y compris les - qui sont "seuls", je ne sais pas si c'est envisageable).

2/Transformer la sélection (tableau D9:S37, dont la taille peut varier en largeur/hauteur) en une matrice à X colonnes, ou X est la valeur en E4, ici 6, mais cela peut varier de 1 à n. Cette nouvelle matrice sera collé autre part (en D46 dans mon fichier, mais pourquoi pas dans un nouvel onglet). La hauteur de la matrice (nombre de ligne) s'adaptera automatiquement, en fonction de mon nombre de colonne. J'ai cherché à le faire avec TRANSPOSE, sans succès.

3/Donner un nom à cette nouvelle Matrice, selon la cellule E5 (ici MATR1)

Quelqu'un aurait une idée? Est-ce qu'une macro pourrait faire ça?

Je vous remercie par avance

 

[Dranreb]

Re : Nettoyer et transformer matrice NxM en une matrice PxL, P pouvant varier

Bonsoir.

Cette procédure a fonctionné du premier coup :

Option Explicit

Sub CopieMat()
Dim NbCol As Long, NomMat As String, T As Variant, Cel As Range, _
   V As Variant, L As Long, C As Long
NbCol = ActiveSheet.[E4].Value
NomMat = ActiveSheet.[E5].Value
ReDim T(1 To Selection.Count \ NbCol + 1, 1 To NbCol)
For Each Cel In Selection
   V = Cel.Value
   If IsNumeric(V) Then
      If V <> 0 Then
         C = C Mod NbCol + 1: If C = 1 Then L = L + 1
         T(L, C) = V: End If: End If: Next Cel
Worksheets.Add After:=ActiveSheet
With ActiveSheet.[A1].Resize(L, NbCol):
   .Value = T: .Name = NomMat: End With
End Sub

 

[Circark]

Re : Nettoyer et transformer matrice NxM en une matrice PxL, P pouvant varier

Bonsoir.

Cette procédure a fonctionné du premier coup :

Option Explicit

Sub CopieMat()
Dim NbCol As Long, NomMat As String, T As Variant, Cel As Range, _
   V As Variant, L As Long, C As Long
NbCol = ActiveSheet.[E4].Value
NomMat = ActiveSheet.[E5].Value
ReDim T(1 To Selection.Count \ NbCol + 1, 1 To NbCol)
For Each Cel In Selection
   V = Cel.Value
   If IsNumeric(V) Then
      If V <> 0 Then
         C = C Mod NbCol + 1: If C = 1 Then L = L + 1
         T(L, C) = V: End If: End If: Next Cel
Worksheets.Add After:=ActiveSheet
With ActiveSheet.[A1].Resize(L, NbCol):
   .Value = T: .Name = NomMat: End With
End Sub

Wow, merci beaucoup Dranreb c'est pile ce qu'il me fallait. J'ai testé et ça marche plutôt bien. J'ai juste remarqué une petite erreur: les 0 sont automatiquement supprimés (celui en K9 par exemple) et du coup n'apparaissent plus dans la nouvelle matrice. Une idée?

Merci encore!

 

[Tirou]

Re : Nettoyer et transformer matrice NxM en une matrice PxL, P pouvant varier

A vue de nez, il faut transformer

If V <> 0 Then
         C = C Mod NbCol + 1: If C = 1 Then L = L + 1
         T(L, C) = V: End If: End If: Next Cel

en

         C = C Mod NbCol + 1: If C = 1 Then L = L + 1
         T(L, C) = V: End If: Next Cel

 

[Bebere]

Re : Nettoyer et transformer matrice NxM en une matrice PxL, P pouvant varier

bonjour Circak,Dranreb,Tirou

If V >= 0 Then

 

[Circark]

Re : Nettoyer et transformer matrice NxM en une matrice PxL, P pouvant varier

Merci, grâce à vous j'ai partiellement réussi:

Option Explicit
 
Sub CopieMat()
 Dim NbCol As Long, NomMat As String, T As Variant, Cel As Range, _
    V As Variant, L As Long, C As Long
 NbCol = ActiveSheet.[E4].Value
 NomMat = ActiveSheet.[E5].Value
 ReDim T(1 To Selection.Count \ NbCol + 1, 1 To NbCol)
 For Each Cel In Selection
    V = Cel.Value
    If IsNumeric(V) Then
       If V <> 0 Or V = 0 Then
          C = C Mod NbCol + 1: If C = 1 Then L = L + 1
          T(L, C) = V: End If: End If: Next Cel
 Worksheets.Add After:=ActiveSheet
 With ActiveSheet.[A1].Resize(L, NbCol):
    .Value = T: .Name = NomMat: End With
 End Sub

J'ai bien mes 0 qui sont là, mais j'ai maintenant aussi les espaces vides dans ma nouvelle matrice

 

[Dranreb]

Re : Nettoyer et transformer matrice NxM en une matrice PxL, P pouvant varier

Bonjour

If Not IsEmpty(V) And IsNumeric(V) Then

 

[ROGER2327]

Re : Nettoyer et transformer matrice NxM en une matrice PxL, P pouvant varier

Bonjour à tous.

Un autre essai. Le code est dans un module standard.​

ℝOGER2327
#6976

Lundi 16 As 141 (Saint Cap, captain - fête Suprême Quarte)
28 Brumaire An CCXXII, 4,5278h - coing
2013-W47-1T10:52:00Z

 

[Circark]

Re : Nettoyer et transformer matrice NxM en une matrice PxL, P pouvant varier

C'est parfait !
Merci beaucoup ROGER2327, Dranreb, Tirou et Bebere