Ahoj,
potřeboval bych poradit, jak v excelu (VB) udělám následovné: př: oblast B2:B13 bude obsahovat přítomné lidi v práci (max. 11lidí) s tím, že počet se liší podle docházky, může bát jen 5 lidí z určené oblasti. V další záložce bych měl sloupec obsahující čísla úkolů pod sebou (třeba 500řádků). A potřeboval bych aby se jména z vybrané oblasti (ted jich je třeba jen 5) se nakopírovala vedle čísla úkolu začínající od prvního řádku a vybrané jména se budou pod sebou opakovat podle zadaného počtu v nějaké bunce (třeba 12 = jméno se bude max. 12x opakovat = člověk dostane 12 čísel úkolů)-.
nemůžu přijít na to, jak zadat dle určitého počtu kopírování pod sebe, někdy může být 11jmen a každé dostane 20 úkolů...
Díky za radu, Pavel
Kopírování "jmen" pod sebe dle daného počtu Vyřešeno
-
- Level 1
- Příspěvky: 99
- Registrován: červenec 10
- Pohlaví:
- Stav:
Offline
Kopírování "jmen" pod sebe dle daného počtu Vyřešeno
- Přílohy
-
- RADA.xlsx
- příklad příloha
- (12.57 KiB) Staženo 13 x
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: Kopírování "jmen" pod sebe dle daného počtu
Procedura resici pozadovane, (v edotoru VBA vlozit do standardniho modulu, volat klavesovou zkratkou nebo z menu):
PS.: Je mozno doplnit preneseni oznacenych jmen z listu dochazka na list1 pouzitim funkci listu.
mozne reseni je v priloze:
Kód: Vybrat vše
Option Explicit
Sub PrirazeniPracovniku()
Dim SBlk As Range, SCll As Range
Dim TCll As Range, Opakovat As Byte, OfsR As Integer
' deklarovat blok seznamu pracovniku a nacist pocet opakovani
With Worksheets("list1")
Set SBlk = .Range(.Range("b2"), .Range("b2").End(xlDown))
If SBlk.Rows.Count > 11 Then MsgBox "Seznam pracovniku je prazdny": GoTo ErrExit
If Not IsNumeric(.Range("g2").Value) Then MsgBox "Chyba v zadani poctu opakovani": GoTo ErrExit
Opakovat = Int(.Range("g2").Value)
End With
Set TCll = Worksheets("data").Range("b2")
' ve smycce vlozit opakovane jmena na list Data
OfsR = 0
Do While Opakovat > 0
For Each SCll In SBlk.Cells
TCll.Offset(OfsR, 0).Value = SCll.Value
OfsR = OfsR + 1
Next SCll
Opakovat = Opakovat - 1
Loop
Set TCll = Nothing
Set SCll = Nothing
ErrExit:
Set SBlk = Nothing
End Sub
PS.: Je mozno doplnit preneseni oznacenych jmen z listu dochazka na list1 pouzitim funkci listu.
mozne reseni je v priloze:
- Přílohy
-
- Rada.xls
- (55.5 KiB) Staženo 14 x
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
- 3
- 2094
-
od Melvidor
Zobrazit poslední příspěvek
21 črc 2023 08:41
-
-
Obnoveni ztracenych fotek z telefonu pri kopirovani do pc
od Dizzy66 » 21 led 2024 17:08 » v Vše ostatní (sw) - 2
- 1318
-
od šulda
Zobrazit poslední příspěvek
23 úno 2024 07:12
-
-
-
Kontrola kopírování dat z jednoho disku na druhý Příloha(y)
od orfan » 25 dub 2024 11:59 » v Vše ostatní (sw) - 15
- 957
-
od orfan
Zobrazit poslední příspěvek
25 dub 2024 19:51
-
-
-
Libre Office Calc - Divné chování při kopírování textu Příloha(y)
od EZumrova » 02 dub 2024 08:12 » v Kancelářské balíky - 14
- 2201
-
od kecalek
Zobrazit poslední příspěvek
05 dub 2024 19:11
-
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 5 hostů