• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: Excel - výběr buněk

Zaslal/a Petan 9.4.2013 19:17

Zdravím,
mám v Excelu dva listy. Na jednom listě je 30 řádků určených k tisku. Na druhém listu (Seznam zařízení) je tabulka s řádky (řádově stovky), které se pomocí makra vkládají na 1. list.

V makru je v podstatě důležité to, že se (teď) vybere vždy 30 po sobě jdoucích řádků a vloží se do listu2 (Tabulka k tisku).

Můj problém spočívá v tom, že můžu seznam zařízení třídit. Takže nevidím vždy postupné buňky 1, 2, 3, 4, 5, 6 atd, ale třeba 20, 50, 66, 80 a já bych potřeboval, aby se překopírovaly tyto viditelné řádky.

Vůbec nic, kromě třídění jak v listu, tak v makru (což by bylo asi poměrně složité) mě nenapadá.

Nějaké nápady?
Díky moc

Makro sloužící ke kopírování vždy 30 řádků.

Public Sub NaplneniTabulky()
' na List1 (Tabulka k tisku) jsou v oblasti "$A$4:$T$53" data k tisku...
' na List2 (Seznam zarizeni) jsou od A1 data pro vkládání po 30 řádcích do List1 od řádku 7
Dim i As Integer
Dim j As Integer

Dim PocetStranek As Integer
Dim OblastProCopy As Range ' adresa oblasti pro kopírování
Dim Adresa As String ' pro sestavení adresy oblasti pro kopírování

Dim OdRadku As Integer

OdRadku = 5 'první řádek (číslo řádku)
Const PocetRadku As Integer = 30 'počet řádků pro kopírování
Const CelkemRadku As Integer = 3500 'celkový počet řádků (číslo řádku)

Dim Strana As Integer, StranCelkem As Integer
' načtení vstupních hodnot:
PocetStranek = Sheets("Tabulka k tisku").Range("T2").Value
Strana = (OdRadku - 1) / PocetRadku + 1
StranCelkem = PocetStranek + Strana - 1

'ZJIŠTĚNÍ POČTU STRAN
For j = OdRadku To CelkemRadku 'prohledává záznam 4-3000

'pokud je nalezena prázdná buňka
If Sheets("Seznam zařízení").Range("B" & j).Value = "" Then

If (j - OdRadku) Mod PocetRadku > 0 Then
Sheets("Tabulka k tisku").Range("U2").Value = "z " & ((j - OdRadku) \ PocetRadku) + 1
Else
Sheets("Tabulka k tisku").Range("U2").Value = "z " & (j - OdRadku) \ PocetRadku
End If

If Sheets("Tabulka k tisku").Range("U2").Value = "z 0" Then MsgBox "Žádná data k tisku", vbInformation

j = CelkemRadku 'ukončení smyčky
End If

Next


'VKLÁDÁNÍ ŘÁDKŮ DO 1. LISTU
For i = 1 To PocetStranek
Adresa = "A" & OdRadku & ":U" & OdRadku + PocetRadku - 1
Sheets("Seznam zařízení").Range(Adresa).Copy
Sheets("Tabulka k tisku").Range("A7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
OdRadku = 5 + PocetRadku
Strana = (OdRadku - 1) / PocetRadku + 1
DoEvents
Next
End Sub

Zaslat odpověď >

---

eLCHa(10.4.2013 7:15)#012777

Nejsem si jistý, jestli jsem to pochopil správně, ale tak jak jsem to pochopil tak bez maker

2 varianty PoSobe je bez používání filtru, Filtr je s použitím filtru

Příloha: 12777_sesit2.zip (42kB, staženo 26x)

citovat

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse