Numar curent VBA Excel

[adof]

sal
ma paoate ajuta cineva si pe mine cu un cod VBA care sa scrie în colana Nr. CRT. într-un tabel Exel
cifrele în ordine crescătoare dacă pe acelasi celula din dreapta este scris ceva

multumesc

[IPP]

Buna ziua

Aveti spre testare un fisier.

Am folosit urmatorul cod:

Cod: Selectaţi tot

Sub InsertNrCrt()

'IPP - 11.06.2012

Application.ScreenUpdating = False

Dim lRow As Long
lRow = Sheets("Sheet1").Range("B65536").End(xlUp).Row

Dim NrCrt As Long
NrCrt = 0

Sheets("Sheet1").Select
Range("A2").Select

Do Until ActiveCell.Row = lRow + 1
    If Len(ActiveCell.Offset(0, 1)) <> 0 Then
     NrCrt = NrCrt + 1
     ActiveCell.Value = NrCrt
    End If
 ActiveCell.Offset(1, 0).Select
Loop

Application.ScreenUpdating = True

End Sub

Pentru testare: deschideti fisierul atasat, activati macro si rulati de la "buton"

IP

[adof]

e super multumesc
completeaza chiar daca are spatii intre înscrieri

întrebare
se poate sa apară atunci cifrele din coloana nr.crt. cind completez celula cu inscrisuri fara sa mai apas butonul Nr. crt ?

[IPP]

Buna ziua

O varianta ar fi un cod plasat la nivel de Sheet1 care reactioneaza la modificarea de pe coloana B

Cod: Selectaţi tot

Private Sub Worksheet_Change(ByVal Target As Range)

'IPP - 11.06.2012

If Not Intersect(Target, Range("B2:B65536")) Is Nothing Then
   
Application.ScreenUpdating = False
   
Dim lRow As Long
lRow = Range("B65536").End(xlUp).Row

Dim NrCrt As Long
NrCrt = 0

Range("A2").Select

Do Until ActiveCell.Row = lRow + 1
    If Len(ActiveCell.Offset(0, 1)) <> 0 Then
     NrCrt = NrCrt + 1
     ActiveCell.Value = NrCrt
     Else: ActiveCell.Value = ""
    End If
 ActiveCell.Offset(1, 0).Select
Loop

Application.ScreenUpdating = True

End If

End Sub

IP

[adof]

sal

multumesc

dar exista todeauna un dar

daca vreau sa introduc o coloană sau doua înainte de coloana A
codul nu mai funcţionează deoarece este prevazut sa citească coloana B

se poate adapta codul ca să citească celulele
iar sub cea care gaseşte Nr. Crt. să înscrie numerele dacă în coloana din dreapata este înscris ceva

stiu ca vreau tot mai mult dar
sper ca nu e cu suparare
sal

[IPP]

Buna ziua

"Tehnic vorbind" probabil ca se poate face ceva dar (exista intotdeauna un dar nu-i asa?) asta ar presupune ceva de genul: "la fiecare schimbare in TOATA foaia (asta pentru ca nu sti unde se vor insera la un moment dat coloanele), cauta Nr.Crt, seteaza noul domeniu de celule de interes, insereaza numarul curent". Nu stiu altii, dar eu evit pe cat posibil rularea unui cod la ORICE modificare in foaia de calcul pentru ca sunt sanse mari ca (in functie de ce formule mai exista in foaie si nu numai) sa ajunga sa se blocheze tot si sa fi nevoit sa inchizi fisierul fortat (--> riscul de a pierde date)

Din punctul meu de vedere, un compromis acceptabil ar fi un macro care sa ruleze de la buton (asadar doar atunci cand e cazul). Asta pentru ca acel macro poate contine instructiunile care duca la inserarea numarului curent oriunde ar fi tabelul cu pricina fara alta interventie a utilizatorului

IP

[adof]

sal

ai mare dreptate cu amestecul de formule
si m-am gindit că o sa spui ca e cam rau să caute în toata foaia

DAR

cum as putea folosi codul fara buton în cazul în care inserez o coloană în pagina respectivă sau sterg o coloană
(probabil o conditie care sa modifice numele B în C sau sa adune/sacada nr coloanei deoarece am vazut întrun fisier Exel coloanele numerotate în loc de Litere)

credema ca fac tabele o grămadă şi deja im ajunge de cite Nr. Crt. trag în jos le modific adaug rânduri si sterg rânduri şi iara le reactualizez

am învatat fucţia Vlookup şi ma folosesc de nr. crt ca de un id intr-o bază de date

mersi

[IPP]

Buna ziua

Propunerea mea finala este urmatoarea:

Un fisier cu macro (vedeti fisierul atasat) care cauta prima aparitie a informatiei NrCrt (cautand de la inceputul foii) si executa instructiunile de inserare a Nr.Crt in functie de criteriile deja discutate si exemplificate anterior. Rularea se poate face si folosind scurtatura Ctrl+Shift+N (scurtatura ce poate fi schimbata).

Macro functioneaza in orice fisier deschis si foaie activa la un moment dat DACA fisierul care contine macro respectiv este deja deschis. (Practic, trebuie sa deschideti mai intai fisierul care contine macro si sa-l lasati deschis atat timp cat aveti nevoie de el dupa care deschideti fisierul in care doriti sa se faca inserarea numarului curent)

Am folosit urmatorul cod:

Cod: Selectaţi tot

Sub InsertNrCrt()

'IPP - 20.06.2012
'CTRL+SHIFT+N

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    
    Cells.Find(What:="nr*crt", After:=Range("A1"), LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Offset(1, 0).Select
     

Dim Coloana
Coloana = ActiveCell.Offset(0, 1).Column
Dim lRow As Long
 lRow = Cells(65536, Coloana).End(xlUp).Row

Dim NrCrt As Long
NrCrt = 0

Do Until ActiveCell.Row = lRow + 1
    If Len(ActiveCell.Offset(0, 1)) <> 0 Then
     NrCrt = NrCrt + 1
     ActiveCell.Value = NrCrt
     Else: ActiveCell.Value = ""
    End If
ActiveCell.Offset(1, 0).Select
Loop

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

IP

[adof]

sal

ideea este super

îmi fac un fisier tipizat care sa conţina Macro

dar la mine nu funcţionrează

am atasat fisierul cu eroarea care apare

[IPP]

Regret, eu n-am avut nicio eroare la testele efectuate.

Eventual incercati sa stergeti parte din instructiunea cu probleme, codul devenind:

Cod: Selectaţi tot

    Cells.Find(What:="nr*crt", After:=Range("A1"), LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False).Offset(1, 0).Select