Numerotare automata repetitiva

[mihai76s]

Buna ziua, putin ajutor va rog. Am un tabel cu 20000 de randuri unele completare altele nu. Ordinea completarii este aleatorie. Ma intereseaza daca pot numerota automat tot tabelul, dar de la 1 dupa ce intalneste un rand completat, aceasta numerotare sa fie repetitiva incepand cu primul rand intalnit liber din tabel.

[IPP]

Buna ziua

Ar fi fost bine daca ati fi atasat si un fisier exemplu. Prima neclaritate din enuntul problemei este cea legata de ce intelegeti dvs. prin tabel/lista. Prin definitie, in Excel o lista este informatia delimitata de cel putin un/o rand/coloana gol/goala. O lista trebuie sa aiba cel putin o coloana si un rand completate integral. Folosind instrumentul Table (valabil incepand cu Excel 2007), se poate "pacali" aceasta definitie insa nu prea este recomandabil.

De asemenea si restul enuntului poate fi interpretabil:
-varianta de intelegere: in lista exista niste "calupuri" de informatie separate de cate un rand gol. numerotarea trebuie sa se faca pentru fiecare dintre aceste calupuri, randul gol fiind criteriul care determina reluarea numararii
-varianta de intelegere: in lista exista calupri de informatie dar si randuri goale (unul sau mai multe, unul dupa altul). orice rand cu informatie fiind criteriul care determina reluarea numararii, cu alte cuvinte se numeroteaza randurile goale.

In oricare dintre variante cred ca se poate gasi o solutie folosind macro, insa asa cum spuneam, un fisier exemplu fara informatii confidentiale (si nu e nevoie de 20000 de randuri ci de cat e strict necesar pentru intelegerea corecta a tuturor datelor problemei) si daca e cazul cu ilustrarea rezultatului asteptat, ar ajuta

IP

[TudyBTH]

Buna,
Dupa cum a aratat mai sus dl. IPP este cam saracacios si interpretabil enuntul problei.
Aveti mai jos un cod VBA care va poate da o idee de abordare a problemei.

Cod: Selectaţi tot

Sub Numerotare()
    Dim rList As Range, rCell As Range
    Dim i As Long, rw As Long, col As Long, poz As Long
    Set rList = ActiveSheet.UsedRange
    Set rCell = Application.InputBox(Prompt:="Selectati celula din care doriti sa inceapa numerotarea.", _
    Title:="Numerotare automata", Type:=8)
    Application.ScreenUpdating = False
    If rCell Is Nothing Then
        MsgBox "Nu ati selectat nimic."
        GoTo iesire
    ElseIf rCell.Cells.Count > 1 Then
        MsgBox "Selectati o singura celula."
        GoTo iesire
    ElseIf Intersect(rCell, rList) Is Nothing Then
        MsgBox "Selectati o celula in interiorul campului de date."
        GoTo iesire
    End If
    rw = rCell.Row: col = rCell.Column: i = 0: poz = 0
    Set rCell = Intersect(ActiveSheet.Rows(rw), rList)
    Do While Not rCell Is Nothing
        If Application.WorksheetFunction.CountBlank(rCell) < rCell.Columns.Count Then
            poz = poz + 1
            ActiveSheet.Cells(rw + i, col) = poz
        Else
            poz = 0
        End If
        i = i + 1: Set rCell = Intersect(ActiveSheet.Rows(rw + i), rList)
    Loop
iesire:
    If Not rList Is Nothing Then Set rList = Nothing
    If Not rCell Is Nothing Then Set rCell = Nothing
End Sub

vedeti si fisierul atasat