Adaptation d'une macro à base de variable Tableau

Version imprimable

Bonjour,

suite à un problème de reclassement de données, on m'a proposé via le forum une macro VBA fonctionnelle (et dans un temps record ! - encore merci Mercatog !) qui m'a facilité la vie.

La voici (légèrement remaniée pour qu'elle colle à mes données) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Sub ReclassementData()
 
Dim LastLig As Long, i As Long, j As Long
Dim N As Long, M As Long, Nb As Long
Dim k As Byte
Dim Tb, Res()
 
Application.ScreenUpdating = False
ActiveSheet.Name = "Feuil1"
Sheets.Add After:=ActiveSheet
 
 
With Worksheets("Feuil1")
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    N = 20 
    If N > 0 Then
        M = Application.Max(.Range("B2:B" & LastLig))
        Nb = M / N + 1
        Tb = .Range("A2:P" & LastLig)
        ReDim Res(1 To Nb, 1 To 14)
 
        For i = 1 To Nb
            Res(i, 1) = N * (i - 1)
            For j = 1 To LastLig - 1
                If Res(i, 1) >= Tb(j, 1) And Res(i, 1) <= Tb(j, 2) Then
                    For k = 2 To 14
                        If Res(i, k) = "" And Tb(j, k + 2) <> "" Then Res(i, k) = Tb(j, k + 2)
                    Next k
                End If
            Next j
        Next i
    End If
 
    With Sheets("Feuil2").Range("A1")
        .Resize(1, 14) = Array("Temps", "Var1", "Var2", "Var3", "Var4", "Var5", "Var6", "Var7", "Var8", "Var9", "Var10", "Var11", "Var12")
        .Offset(1).Resize(Nb, 14) = Res
    End With
End With
End Sub

Malheureusement, il me reste encore un problème que je ne parviens à résoudre (et qui provient de toute évidence de mon ignorance en termes de syntaxe VBA)
Il me faut aller en réalité plus loin dans l'adaptation de cette macro, de façon à ce qu'elle s'applique à des tableaux de départ où les nombres de colonnes (variables) peuvent différer.
J'ai donc tenté différentes manière d'implémenter un "LastCol" (voir définition exacte dans le code ci-dessous) pour prendre en compte la dernière colonne dans les différentes formules du code. Mais rien n'y fait...

Voici la dernière version du code (qui bloque à partir de la définition du Tb, dans la boucle If, avec une erreur 1004 - Erreur définie par l'application ou par l'objet) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Sub NEWReclassementData()
 
Dim LastLig As Long, i As Long, j As Long
Dim N As Long, M As Long, Nb As Long
Dim k As Byte
Dim Tb, Res()
Dim LastCol As Long
 
Application.ScreenUpdating = False
ActiveSheet.Name = "Feuil1"
Sheets.Add After:=ActiveSheet
 
 
With Worksheets("Feuil1")
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    LastCol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    N = 20
    If N > 0 Then
        M = Application.Max(.Range("B2:B" & LastLig))
        Nb = M / N + 1
        Tb = .Range(Cells(2, 1), Cells(LastLig, LastCol))
        ReDim Res(1 To Nb, 1 To LastCol - 2) '--> Je souhaite utiliser un LastCol - 2, car les deux premières colonnes de "Feuil1" ne sont pas concernées par le reclassement 
 
        For i = 1 To Nb
            Res(i, 1) = N * (i - 1)
            For j = 1 To LastLig - 1
                If Res(i, 1) >= Tb(j, 1) And Res(i, 1) <= Tb(j, 2) Then
                    For k = 2 To LastCol - 2
                        If Res(i, k) = "" And Tb(j, k + 2) <> "" Then Res(i, k) = Tb(j, k + 2)
                    Next k
                End If
            Next j
        Next i
    End If
 
    With Sheets("Feuil2").Range("A1")
        .Resize(1, LastCol - 2) = Array(Range(Worksheets("Feuil1").Cells(1, 3), Worksheets("Feuil1").Cells(1, LastCol)))
        .Offset(1).Resize(Nb, LastCol - 2) = Res
        .Range("A1").Select
    End With
 
End With
End Sub

Je vous remercie pour toute suggestion ou éléments de syntaxe qui pourraient me sortir de ce mauvais pas.

Cordialement,

PS : A toutes fins utiles, je peux joindre un fichier de données en exemple...

23/04/2014, 12h06
mercatog

Citation:

PS : A toutes fins utiles, je peux joindre un fichier de données en exemple...

Vu que le code existe bien, en effet, un fichier exemple sera souhaitable
23/04/2014, 12h21
ldescham

1 pièce(s) jointe(s)

Bonjour,

Voici un fichier de données brutes en exemple :

Pièce jointe 143752

Cordialement,
23/04/2014, 12h33
Marc-L

Bonjour.

Citation:

Envoyé par ldescham

Il me faut aller en réalité plus loin dans l'adaptation de cette macro, de façon à ce qu'elle s'applique à des tableaux de départ où les nombres de colonnes (variables) peuvent différer.

Ne pas oublier la propriété CurrentRegion délimitant automatiquement lignes et colonnes !

Sa propriété .Columns.Count renseigne le total de colonnes.

Sinon associée à une variable tableau, voir du côté de la fonction UBound pour renvoyer le nombre de lignes ou de colonnes …
23/04/2014, 12h38
ldescham

Citation:

Si les données sont contigües, ne pas oublier la propriété CurrentRegion délimitant automatiquement lignes et colonnes !

Ok, je regarde ça et j'essaie de l'appliquer.

Reprenant l'ancien code (y compris la définition de N. que je vois que tu as fixé en dur dans le code)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Sub Traitement()
Dim LastLig As Long, i As Long, j As Long
Dim N As Long, M As Long, Nb As Long
Dim LastCol As Integer, k As Integer
Dim WsD As Worksheet
Dim Tb, Res()
 
Application.ScreenUpdating = False
Set WsD = Worksheets("Exemple")
With WsD
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
 
    N = Application.Min(.Range("C2:C" & LastLig))
 
    If N > 0 Then
        M = Application.Max(.Range("B2:B" & LastLig))
        Nb = M / N + 1
        Tb = .Cells(2, 1).Resize(LastLig - 1, LastCol)
        ReDim Res(1 To Nb, 1 To LastCol - 2)
 
        For i = 1 To Nb
            Res(i, 1) = N * (i - 1)
            For j = 1 To LastLig - 1
                If Res(i, 1) >= Tb(j, 1) And Res(i, 1) <= Tb(j, 2) Then
                    For k = 2 To LastCol - 2
                        If Res(i, k) = "" And Tb(j, k + 2) <> "" Then Res(i, k) = Tb(j, k + 2)
                    Next k
                End If
            Next j
        Next i
    End If
End With
 
With Worksheets.Add.Range("A1")
    .Resize(1, LastCol - 2).Value = WsD.Cells(1, 3).Resize(1, LastCol - 2).Value
    .Offset(1).Resize(Nb, LastCol - 2) = Res
End With
Set WsD = Nothing
 
MsgBox "Traitement terminé!"
End Sub

23/04/2014, 13h28
ldescham

Merci ça fonctionne parfaitement !

Et je garde en stock (en plus des nouveaux éléments de syntaxe contenus dans ce code), la fonction CurrentRegion, que j'expérimentais sans toutefois parvenir directement à mes fins...

Cordialement,