XL 2013 [Résolu] Test tableau

Lone-wolf

XLDnaute Barbatruc
Bonjour à toutes et à tous :)

j'ai créé cette macro

VB:
Option Explicit

Sub test()
Dim i&, num%, tbl, tablo()

    Application.ScreenUpdating = False
    tbl = Range("a2:a" & Range("a" & Rows.Count).End(xlUp).Row)
    num = 1
    ReDim Preserve tablo(1 To UBound(tbl), 1 To 1)

    For i = 2 To UBound(tbl)
        If tbl(i, 1) = tbl(i - 1, 1) Then
            num = num + 1
            tablo(i, 1) = num
        Else
            num = 1
            tablo(i, 1) = num
        End If
    Next i
    [B2].Resize(UBound(tbl), 1) = tablo

End Sub

Je ne comprends pas ce qui est faux dans celle-ci. Danns la cellule B2, il devrait inscire 1, mais ce n'est pas le cas.
 

Pièces jointes

  • Classeur1.xlsm
    8.2 MB · Affichages: 52

ChTi160

XLDnaute Barbatruc
Bonjour Lone-wolf
Bonjour le Fil , le Forum
voila ce que j'ai fait et qui semble fonctionne.
VB:
Option Explicit
Option Base 1
Sub test()
Dim i&, num%, tbl, tablo()
Dim x&
    Application.ScreenUpdating = False
    tbl = Range("a1:a" & Range("a" & Rows.Count).End(xlUp).Row)
    num = 1
      x = 0
   For i = 2 To UBound(tbl)
       x = x + 1
        ReDim Preserve tablo(1, x)
        If tbl(i, 1) = tbl(i - 1, 1) Then
            num = num + 1
                  tablo(1, x) = num
        Else
            num = 1
                  tablo(1, x) = num
        End If
    Next i
    [B2].Resize(UBound(tablo, 2)) = Application.Transpose(tablo)
Erase tablo
num = 0: i = 0
End Sub
voir Fichier
Bonne fin de journée
Jean marie
 

Pièces jointes

  • Classeur1 Chti160.xlsm
    8.2 MB · Affichages: 18
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @Lone-wolf, à tous,

Une autre piste avec un seul tableau pour le fun :
VB:
Sub test()
Dim i&, tbl, dat
   With Range("a2:a" & Range("a" & Rows.Count).End(xlUp).Row)
      tbl = .Value: dat = tbl(1, 1): tbl(1, 1) = 1
      For i = 2 To UBound(tbl)
         If tbl(i, 1) = dat Then
            tbl(i, 1) = tbl(i - 1, 1) + 1
         Else
            dat = tbl(i, 1): tbl(i, 1) = 1
         End If
      Next i
      .Offset(, 1).Resize(Rows.Count - 1).Clear
      .Offset(, 1).Value = tbl
   End With
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 923
Membres
101 840
dernier inscrit
SamynoT