Imam problem kako na stranici FILTER kada se filtriraju podaci ( pomoću dugmeta FILTER ) u koloni A upiše redne brojeva onoliko koliko ima lica . Ako neko ima volje za pomoć zakačio sam datoteku
Automatsko doodavanje rednih brojeva nakon filtriranja
Zaključano
Zakačeno
izmenjeno 1 put, poslednji put Jpeca 24.01.2018. u 10:19
Izmene poruke
- Jpeca24.01.2018. u 10:19zapis iz teksta poruke
Recimo u A koloni (A11) dodaj formulu
Formula gleda susedno polje (B kolona) i ukoliko je ono popunjeno (nije prazno) uvećava vrednost iznad za 1, ako ne onda ostaje prazno
Kopiraj ovu formulu ispod dokle treba - za slučaj kad je spisak potpun.
Pošto brišeš redove u filtr proceduri, možeš ovu formulu da postaviš u kodu
Code:
=IF(B11<>"";A10+1;"")
=IF(B11<>"";A10+1;"")
Formula gleda susedno polje (B kolona) i ukoliko je ono popunjeno (nije prazno) uvećava vrednost iznad za 1, ako ne onda ostaje prazno
Kopiraj ovu formulu ispod dokle treba - za slučaj kad je spisak potpun.
Pošto brišeš redove u filtr proceduri, možeš ovu formulu da postaviš u kodu
Potpis
Nije to loše Rembrante, samo što ne bi dodao još malo boje?
Kada sam iskopirao formulu u kolonu A ( funkcioniše ) ali s obzirom da prilikom filtriranja briše kolone kada se bira drugi klub formula se tada ne pojavljuje ( što je i normalno s obzirom na vb kod ) tako da nije upotrebljivo e sada bih zamolio JPECU da mi pomogne da se u koloni A DODA JEDAN KOLONA (A kolona ) ISPRED BR:LICENCE GDE ĆE SE PRILIKOM FILTRIRANJA POJAVLJIVATI TI BROJEVI
Blokirao sam i nemam rešenje a bilo bi mi korisno kada bi se ovaj problem rešio
Unapred zahvalan
Blokirao sam i nemam rešenje a bilo bi mi korisno kada bi se ovaj problem rešio
Unapred zahvalan
Ovo je procedura koja dodaje navedenu formulu kroz VBA,
Pozoveš je nakon kopiranja, pre skip_copying, tako da se nakon brisanje formule svaki put dodaju
Code:
Private Sub DodajRbr()
Dim rwEnd As Long
Dim r As Long
Const rwStart As Integer = 11
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Filter")
rwEnd = sh.Range("B50000").End(xlUp).Row ' Last row
For r = rwStart To rwEnd
sh.Cells(r, 1).FormulaR1C1 = "=R[-1]C[0]+1"
Next r
End Sub
Private Sub DodajRbr()
Dim rwEnd As Long
Dim r As Long
Const rwStart As Integer = 11
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Filter")
rwEnd = sh.Range("B50000").End(xlUp).Row ' Last row
For r = rwStart To rwEnd
sh.Cells(r, 1).FormulaR1C1 = "=R[-1]C[0]+1"
Next r
End Sub
Pozoveš je nakon kopiranja, pre skip_copying, tako da se nakon brisanje formule svaki put dodaju
Potpis
Nije to loše Rembrante, samo što ne bi dodao još malo boje?
Umesto
Rows("10:" & CStr(n)).Delete Shift:=xlUp
stavi
Range("B11:I50").Clear
Na kraju posle
Application.CutCopyMode = False
dodaj
Sheets("Filter").Range("A10").Clear
Rows("10:" & CStr(n)).Delete Shift:=xlUp
stavi
Range("B11:I50").Clear
Na kraju posle
Application.CutCopyMode = False
dodaj
Sheets("Filter").Range("A10").Clear
Pozdrav
Kako u kodu dodati da na kraju posle ispisa u sheetu Filter doda recimo u koloni G dio teksta kao npr
"Spisak sastavio:
Marko Marković"
Kako u kodu dodati da na kraju posle ispisa u sheetu Filter doda recimo u koloni G dio teksta kao npr
"Spisak sastavio:
Marko Marković"
Hvala svima koji su se bavili temom , posebno JPECI koji je uradio ono što sam hteo.i.........Da li bi neko hteo da napiše kod kojim bi se sakrii podaci kolone B i u njoj upisali redni brojevi.................ili kao još jedno rešenje dodati redne brojeve u tabelu kolone A.........................mislim da ima dosta VB korisnih kodova koje bi članovi ovog foruma mogli da koriste u svojim radovima .....................Još jedanput HVALA JPECA
Citat:
Da li bi neko hteo da napiše kod kojim bi se sakrii podaci kolone B i u njoj upisali redni brojevi
Ako ti ne trebaju podaci iz kolone B onda možeš redne brojeve umesto u koloni A da upišeš u koloni B (2 umesto 1).
Problem sa gornjim kodom je što će formula u prvom redu vratiti grešku jer je B10 ima tekst - nije prazno (t.j. ). Možeš da napraviš komplikovaniju formulu ili jedstavno da upišeš direktno vrednosti
Code:
Private Sub DodajRbr()
Dim rwEnd As Long
Dim r As Long
Const rwStart As Integer = 11
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Filter")
rwEnd = sh.Range("B50000").End(xlUp).Row ' Last row
For r = rwStart To rwEnd
sh.Cells(r, 2).NumberFormat = "General"
sh.Cells(r, 2).Value = r - rwStart + 1
Next r
End Sub
Private Sub DodajRbr()
Dim rwEnd As Long
Dim r As Long
Const rwStart As Integer = 11
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Filter")
rwEnd = sh.Range("B50000").End(xlUp).Row ' Last row
For r = rwStart To rwEnd
sh.Cells(r, 2).NumberFormat = "General"
sh.Cells(r, 2).Value = r - rwStart + 1
Next r
End Sub
Potpis
Nije to loše Rembrante, samo što ne bi dodao još malo boje?
>
HVALA JPECA, "ubacio" sam kod i sve funkcioniše kako sam želeo ( u attachu sam zakacio datoteku )
Imao bih jedno pitanje JPECA ( ako Vam nije problem A I NIJE U OKVIRU OVE TEME ) s obzirom da ste već upaznati sa funkcionisanjem ove baze, da li možete da mi pomognete s obzirom da u zaglavlju stoji naziv kluba da se kolona gde se nalazi naziv kluba ne pojavljuje ( sakrije ) I DA NA DNU IZVEŠTAJA STOJI LINIJA IZA POSLEDNJEG LICA.......................
Ako ovo i ne bude urađeno hvala za veliku pomoć
Imao bih jedno pitanje JPECA ( ako Vam nije problem A I NIJE U OKVIRU OVE TEME ) s obzirom da ste već upaznati sa funkcionisanjem ove baze, da li možete da mi pomognete s obzirom da u zaglavlju stoji naziv kluba da se kolona gde se nalazi naziv kluba ne pojavljuje ( sakrije ) I DA NA DNU IZVEŠTAJA STOJI LINIJA IZA POSLEDNJEG LICA.......................
Ako ovo i ne bude urađeno hvala za veliku pomoć
Citat:
...s obzirom da u zaglavlju stoji naziv kluba da se kolona gde se nalazi naziv kluba ne pojavljuje ( sakrije )
Ako sam razumeo, dovoljno je da selektuješ i sakriješ (Hide) kolonu E, nikakva izmene u programu nije potrebna. Ako želiš da potpuno izbaciš tu kolonu morao bi da se menja način filtriranja - ne može samo copy iz postojeće tabele
Citat:
DA NA DNU IZVEŠTAJA STOJI LINIJA IZA POSLEDNJEG LICA.......................
Što se linije tiče, ako si hteo da dodaš donju ivicu tabele, to može lako da se ubaci u postojeći kod
Code:
Private Sub DodajRbr()
Dim rwEnd As Long
' Ostaje postojeći kod
'...
' Dodaj liniju ispod
With sh.Cells(rwEnd, 2).Resize(ColumnSize:=8).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Sub
Private Sub DodajRbr()
Dim rwEnd As Long
' Ostaje postojeći kod
'...
' Dodaj liniju ispod
With sh.Cells(rwEnd, 2).Resize(ColumnSize:=8).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End Sub
Pošto, prilikom filtiranja brišeš prethodne redove, time će se izbirsati i donja linija, pa ovo dodavanje svaki put nakon filtiranja trebalo bi da bude dovoljno. Verovatno bi moglo i sa ulsovnim formatiranjem - bez dodavanja koda
Potpis
Nije to loše Rembrante, samo što ne bi dodao još malo boje?
Što se tiče skrivanja kolone sa opcijom hide to znam mislio sam da se kroz VB napiše ali nema potrebe.
JPECA ovoj Vaš kod sa linijom je potpuno ok i funkcioniše besprekorno
Dodao sm da u futeru tekst ko je uradio izveštaj i broj stranice kao i u zaglavlju datum i da izbroji ukupan broj lica koja su licencirana......................
Možda je samo trebalo da ispod zadnjeg podatka stoji ko je uradio izveštaj i broj stranice (to nisam znao ) pa sam upiso u footer što je vidljivo jedino kada se štampa................
Dodao sam i repeat headers ali se javlja problem kada obrišem naziv kluba i onda treba da štampa sve trebalo bi da zadnji na toj strani ima liniju ispod a ostaje samo linija na kraju svih ....... verovatno bi se kroz VB code break page to rešilo
Zakačioo sam ispravljenu datoteku, koja je urađena i više nego što je trebalo na početku teme ali ako mogu da se reše i ove stvari koje sam naveo bilo bi perfektno
JPECA ovoj Vaš kod sa linijom je potpuno ok i funkcioniše besprekorno
Dodao sm da u futeru tekst ko je uradio izveštaj i broj stranice kao i u zaglavlju datum i da izbroji ukupan broj lica koja su licencirana......................
Možda je samo trebalo da ispod zadnjeg podatka stoji ko je uradio izveštaj i broj stranice (to nisam znao ) pa sam upiso u footer što je vidljivo jedino kada se štampa................
Dodao sam i repeat headers ali se javlja problem kada obrišem naziv kluba i onda treba da štampa sve trebalo bi da zadnji na toj strani ima liniju ispod a ostaje samo linija na kraju svih ....... verovatno bi se kroz VB code break page to rešilo
Zakačioo sam ispravljenu datoteku, koja je urađena i više nego što je trebalo na početku teme ali ako mogu da se reše i ove stvari koje sam naveo bilo bi perfektno