Excel VBA - práce s listy

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

mihalan
nováček
Příspěvky: 2
Registrován: září 19
Pohlaví: Nespecifikováno
Stav:
Offline

Excel VBA - práce s listy

Příspěvekod mihalan » 09 zář 2019 17:06

Dobrý den,
potřeboval bych poradit. Potřeboval bych vytvořit makro, které by umělo z Excelu
před.xlsx
(11.61 KiB) Staženo 55 x
vytvořit Excel
po.xlsx
(29.6 KiB) Staženo 51 x


Popis práce Makra:
V
před.xlsx
(11.61 KiB) Staženo 55 x
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

Reklama
Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 366
Registrován: červen 13
Pohlaví: Muž
Stav:
Offline

Re: Excel VBA - práce s listy

Příspěvekod elninoslov » 10 zář 2019 09:27

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"

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

mihalan
nováček
Příspěvky: 2
Registrován: září 19
Pohlaví: Nespecifikováno
Stav:
Offline

Re: Excel VBA - práce s listy

Příspěvekod mihalan » 10 zář 2019 15:56

Dobrý den,
to je skvělé. Moc Vám děkuji. :thumbup:


  • 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
  • Notebook kancelářská práce
    od Leopoldkol » 20 úno 2024 21:23 » v Rady s výběrem hw a sestavením PC
    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
  • 220nitů a 400 nitů internet a práce
    od p3v4x » 05 lis 2023 12:33 » v Problémy s hardwarem
    1
    815
    od Kuba5 Zobrazit poslední příspěvek
    06 lis 2023 09:29

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 10 hostů