Dobrý den,
potřeboval bych poradit. Potřeboval bych vytvořit makro, které by umělo z Excelu vytvořit Excel
Popis práce Makra:
V jsou v List1 jsou dva sloupce(B, C) a v List2 je tabulka
Potřebuji
-vytvořit tolik listů kolik je plných buněk v prvním sloupci v List1, prázdné řádky vynechat (v příkladu: 9 plných řádků = 9 vytvořených listů)
-pojmenovat každý list podle prvního sloupce (v příkladu: 1. vytvořený list se bude jmenovat: D.1
2. vytvořený list se bude jmenovat: PS 01-01-01)
-do listů, kterým začíná jméno buď na "PS" nebo "SO" nebo číslo se vloží tabulka z List2
- do těchto tabulek se
a) do buňky C3 vloží odpovídající text z 1. sloupce z list1
b) do bunky A5 vloží odpovídající text z 2. sloupce z list1
- do listů, kterým NEzačíná jméno buď na "PS" nebo "SO" nebo číslo se vloží
a) do bunky B9 text odpovídající text z 1. sloupce z list1
b) do bunky C9 se vloží odpovídající text z 2. sloupce z list1
- do 1. sloupce v List1 vložit hypertextový odkaz, který bude odkazovat na příslušný list
Díky moc za pomoc
Excel VBA - práce s listy
- elninoslov
- Level 2.5
- Příspěvky: 366
- Registrován: červen 13
- Pohlaví:
- Stav:
Offline
Re: Excel VBA - práce s listy
Pod pojmom "vložit" sa rozumie vždy hodnota. Vy máte ale v príklade výsledku vzorce. To je fuk, tu máte verziu kde je jasné v makre, že riadky s .Value vkladajú hodnotu (teraz zelené, vyradené apostrofom z činnosti), a riadky s .Formula vkladajú vzorce.
Pozor! Nieje to ošetrené na situáciu, že:
a) v bunkách budú znaky, ktoré nesmú byť použité v názvoch listov
b) v bunkách je viac znakov ako 31 (maximálna dĺžka názvu listu)
c) list s daným názvom už existuje
Ďalej si dajte pozor aj na to, aby ste v bunkách nemal prebytočné medzery, ako teraz pred " D.2" a " E.1.6"
Pozor! Nieje to ošetrené na situáciu, že:
a) v bunkách budú znaky, ktoré nesmú byť použité v názvoch listov
b) v bunkách je viac znakov ako 31 (maximálna dĺžka názvu listu)
c) list s daným názvom už existuje
Ďalej si dajte pozor aj na to, aby ste v bunkách nemal prebytočné medzery, ako teraz pred " D.2" a " E.1.6"
Kód: Vybrat vše
Sub VytvorListy()
Dim D(), Radku As Long, i As Long, Idx As Integer, WS As Worksheet
With wsData
Radku = .Cells(Rows.Count, 2).End(xlUp).Row - 1
If Radku = 0 Then MsgBox "Chybějí data", vbExclamation: Exit Sub
D = .Cells(2, 2).Resize(Radku, 2).Value2
End With
Application.ScreenUpdating = False
With ThisWorkbook
Idx = .Worksheets.Count
For i = 1 To Radku
If Not IsEmpty(D(i, 1)) Then
If Left$(D(i, 1), 2) = "PS" Or Left$(D(i, 1), 2) = "SO" Or IsNumeric(Left$(D(i, 1), 1)) Then
wsSablona.Copy After:=.Worksheets(Idx)
Set WS = .Worksheets(Idx + 1)
With WS
'.Cells(3, 3).Value = D(i, 1)
'.Cells(5, 1).Value = D(i, 2)
.Cells(3, 3).Formula = "='" & wsData.Name & "'!B" & i + 1
.Cells(5, 1).Formula = "='" & wsData.Name & "'!C" & i + 1
End With
Else
.Worksheets.Add After:=.Worksheets(Idx)
Set WS = .Worksheets(Idx + 1)
With WS.Cells(9, 2).Resize(, 2)
'.Value = Array(D(i, 1), D(i, 2))
.Formula = Array("='" & wsData.Name & "'!B" & i + 1, "='" & wsData.Name & "'!C" & i + 1)
With .Font
.Bold = True
.Size = 12
.Name = "Arial CE"
End With
End With
End If
Idx = Idx + 1
WS.Name = D(i, 1)
wsData.Hyperlinks.Add Anchor:=wsData.Cells(i + 1, 2), Address:="", SubAddress:="'" & D(i, 1) & "'!A1", TextToDisplay:=CStr(D(i, 1))
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
- Přílohy
-
- před.xlsm
- (26.39 KiB) Staženo 56 x
Re: Excel VBA - práce s listy
Dobrý den,
to je skvělé. Moc Vám děkuji.
to je skvělé. Moc Vám děkuji.
-
- 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
- 3298
-
od elninoslov
Zobrazit poslední příspěvek
10 říj 2023 11:38
-
-
-
Výběr zásuvkové lišty (prodlužovačka) Příloha(y)
od Speedhack » 09 zář 2023 15:08 » v Vše ostatní (hw) - 14
- 3543
-
od faraon
Zobrazit poslední příspěvek
12 zář 2023 20:02
-
-
- 2
- 624
-
od Leopoldkol
Zobrazit poslední příspěvek
20 úno 2024 22:39
-
-
QD-Oled a práce s photoshopem (burn-in) ?
od name66 » 06 čer 2023 15:21 » v Rady s výběrem hw a sestavením PC - 1
- 656
-
od Vladicek
Zobrazit poslední příspěvek
07 čer 2023 11:40
-
-
- 1
- 815
-
od Kuba5
Zobrazit poslední příspěvek
06 lis 2023 09:29
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 10 hostů