Ahoj všem a hlavně návštěvníkovi
Mám další problém který nejsem sám schopen vyřešit. Potřebuji v příloze vytáhnout všechna data z tabulky na listu "zadání" a překopírovat na list "výsledek". Datová oblast tabulky bude vždy 12 sloupců a 70 řádků. Díky předem za rady
VBA Excel - vypsání dat z tabulky Vyřešeno
- Branscombe
- Level 3
- Příspěvky: 469
- Registrován: červen 09
- Pohlaví:
- Stav:
Offline
VBA Excel - vypsání dat z tabulky
- Přílohy
-
- prohledani_tabulky.xlsm
- (9.38 KiB) Staženo 31 x
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: VBA Excel - vypsání dat z tabulky
Mozne reseni predstavuje procedura (uprav dle skutecnosti, hlavickovy radek na list Vysledek si vloz):
Kód: Vybrat vše
Option Explicit
Sub Vypis()
Dim BlkKod As Range, CllK As Range, KOfsR As Long
Dim BlkDat As Range, CllD As Range, DOfsC As Long
Dim TBlk As Range, TOfsR As Long
With Worksheets("Zadání")
KOfsR = 0
Set CllK = .Range("a2")
Do
KOfsR = KOfsR + 1
Loop While Len(CllK.Offset(KOfsR, 0).Value) > 0
DOfsC = 0
Set CllD = .Range("b1")
Do
DOfsC = DOfsC + 1
Loop While Len(CllD.Offset(0, DOfsC).Value) > 0
Set BlkKod = .Range("A2").Resize(KOfsR, 1)
Set BlkDat = .Range("b1").Resize(1, DOfsC)
End With
Set TBlk = Worksheets("Výsledek").Range("a2")
TOfsR = 0: KOfsR = 0: DOfsC = 0
For Each CllK In BlkKod.Cells
For Each CllD In BlkDat.Cells
If Len(CllK.Offset(0, DOfsC + 1).Value) > 0 Then
TBlk.Offset(TOfsR, 0).Value = CllK.Value ' kod
TBlk.Offset(TOfsR, 1).Value = CllD.Value ' datum
TBlk.Offset(TOfsR, 2).Value = CllK.Offset(0, DOfsC + 1).Value ' hodnota
TOfsR = TOfsR + 1
End If
DOfsC = DOfsC + 1
Next CllD
DOfsC = 0
KOfsR = KOfsR + 1
Next CllK
Set BlkKod = Nothing
Set CllK = Nothing
Set BlkDat = Nothing
Set CllD = Nothing
Set TBlk = Nothing
End Sub
- Branscombe
- Level 3
- Příspěvky: 469
- Registrován: červen 09
- Pohlaví:
- Stav:
Offline
Re: VBA Excel - vypsání dat z tabulky Vyřešeno
Super, díky moc ... Ještě to otestuji ...
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
-
Excel - z jedné tabulky automaticky vytvořené jednotlivé listy Příloha(y)
od yanetta » 09 říj 2023 10:55 » v Kancelářské balíky - 3
- 3527
-
od elninoslov
Zobrazit poslední příspěvek
10 říj 2023 11:38
-
-
- 0
- 937
-
od Funstorm007
Zobrazit poslední příspěvek
19 dub 2024 21:01
-
- 2
- 1088
-
od Myerina
Zobrazit poslední příspěvek
30 led 2024 08:44
-
- 16
- 6367
-
od mirekol
Zobrazit poslední příspěvek
20 říj 2023 08:31
-
- 3
- 2050
-
od Story-Long
Zobrazit poslední příspěvek
14 srp 2023 10:11
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 41 hostů