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

MS Excel

Téma: Kopie dat z buňěk

Zaslal/a Martin12345678 20.10.2013 15:11

Potřeboval bych zkonzultovat můj problém s kopií dat.
Níže uvedený kód kopíruje oblast buněk do oblasti na jiném listu. Zdrojová data obsahují vzorce a do cílové oblasti vkládám pouze hodnoty. Problém je ten, že v cílovém listu mám nastavený jiný kód, který má z vložené (kopírované)oblasti zjistit obsazené buňky a kde je prázdná buňka tak se skryje řádek. Bohužel ale při vložení kopírované oblasti do cílového listu se i prázdné buňky tváří jako kdyby tam byla data a tak druhý kód na skrytí řádků nefunguje.
Napadlo mě, zda by nešlo již při výběru ze drojové oblasti vybrat, kopírovat jen obsazené buňky (je možné, že mezi obsazenými buňkami budou i prázdné buňky, tudíž by se měla kopírovat oblast od B24 až poslední obsazená buňka)?
Nebo nějaké jiné řešení?
Jsem v koncích, prosím někoho zkušenějšího o pomoc. Předem děkuji. M.
Sheets("Nabídka_im").Select
Range("B24:B373").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Nabídka").Select
Range("B24:B24").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Zaslat odpověď >

---

Strana:  1 2 3   další »

AL(20.10.2013 18:33)#015754

Buď v zdrojovej oblasti použiť filter a skopírovať iba neprázdne bunky, alebo vytvoriť "doplnok" množiny VybranáOblasť mínus PrázdneBunkyVoVybranejOblasti a kopírovať tento Range...

Doplnok množiny rieši napr. tuná nejaký martinee: http://www.mrexcel.com/forum/excel-questions/92743-subtract-ranges.htmlcitovat

Martin12345678(20.10.2013 18:38)#015755

Díky za typ, ale dneska na tom dělám celé odpoledne a už jsem v nouzi a musel jsem tu požádat o pomoc. Můžu tě poprosit (nebo někoho jiného, kdo by si udělal chvilku)o úpravu kódu té první varianty, tak aby se kopírovali jen neprázdné buňky (v rozmezí první až poslední obsazená)?citovat

AL(20.10.2013 19:00)#015756

Je mi záhadou, že pri tom, čo tvoríš (tú aplikáciu pre manželku) a vo svetle toho, čo máš hotové, nie si schopný si poradiť s touto trivialitou .

Za predpokladu, že [B24] v zdrojovej oblasti nie je prázdne, tak takto:Sub pom()
Dim FirstCell As Range, LastCell As Range, SourceRange As Range
With Sheets("Nabídka_im")
Set FirstCell = .[B24]
Set LastCell = FirstCell.End(xlDown)
If Not IsEmpty(LastCell) Then
Set SourceRange = Range(FirstCell, LastCell)
Else: Set SourceRange = FirstCell
End If
End With
SourceRange.Copy
Sheets("Nabídka").[B24].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Set FirstCell = Nothing
Set LastCell = Nothing
Set SourceRange = Nothing
End Subcitovat

AL(20.10.2013 19:53)#015757

No, čítam špatne, takže ten predošlý pokus nie je zrejme to, čo potrebuješ, tu je oprava (dokonca som použil prvýkrát error handler ):Sub SkopirujNeprazdneHodnoty()
Dim FirstCell As Range, LastCell As Range, SourceRange As Range, SourceRangeToLeave As Range
Dim cell As Range, SourceRangeToCopy As Range
With Sheets("Nabídka_im")
Set FirstCell = .[B24]
If IsEmpty(FirstCell) Then Set FirstCell = FirstCell.End(xlDown)
If IsEmpty(FirstCell) Then
Set FirstCell = Nothing
Exit Sub
End If
Set LastCell = .Cells(.Rows.Count, "B")
If IsEmpty(LastCell) Then Set LastCell = LastCell.End(xlUp)
Set SourceRange = Range(FirstCell, LastCell)
If SourceRange.Cells.Count > 2 Then
On Error GoTo ErrHandler
Set SourceRangeToLeave = SourceRange.SpecialCells(xlCellTypeBlanks)
Set SourceRangeToCopy = Nothing
For Each cell In SourceRange.Cells
If Intersect(cell, SourceRangeToLeave) Is Nothing Then
If SourceRangeToCopy Is Nothing Then
Set SourceRangeToCopy = cell
Else: Set SourceRangeToCopy = Union(cell, SourceRangeToCopy)
End If
End If
Next cell
Else: Set SourceRangeToCopy = SourceRange
End If
End With

Label1:
Set FirstCell = Nothing
Set LastCell = Nothing
Set SourceRange = Nothing
Set SourceRangeToLeave = Nothing
Set cell = Nothing

SourceRangeToCopy.Copy
Sheets("Nabídka").[B24].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Set SourceRangeToCopy = Nothing

ErrHandler:
If Err.Number = 1004 Then
Set SourceRangeToCopy = SourceRange
Resume Label1
End If
End Subcitovat

Martin12345678(20.10.2013 22:56)#015762

Díky moc. Zkoušel jsem oba kódy. První přenese data, ale neřeší můj problém:-( Druhý hlásí chybu v tomto místě:
Set SourceRange = Range(FirstCell, LastCell)
Kód jsem vložil pod tlačítko CommandButton1.

Mé znalosti programování jsou typu pokus omyl. Co potřebuji si tak nějak obstarám vzorci a pokud potřebuji něco makrem tak pátrám zde po diskuzi. Takže takový začátečník. Jen pracovně moc nestíhám se samoukou VBA. Proto jsem rád, že mě tu lidi pomáhají.citovat

Martin12345678(20.10.2013 23:09)#015764

Zde přikládám soubor s příkladem.
Kód je přidělen k tlačítku na listu Nabídka.
Je zde i druhý kód, který má skrýt řádky po přenesení dat.

Příloha: 15764_databaze.rar (89kB, staženo 16x)

citovat

AL(20.10.2013 23:54)#015766

Martine, je mi ľúto, ale opravovať to nebudem, skús na to prísť sám, keď nie si schopný dať vzor hneď na začiatku
Len dve poznámky, na liste Nabídka_im:
1. máš na riadku 137 zlúčenú bunku, tú si láskavo zruš, alebo na to upozorni, že bez toho nemôžeš existovať, keď tu píšeš žiadosť o pomoc.
2. v stĺpci B máš okrem prázdnych buniek i bunky obsahujúce vzorce, hodnota je síce "", ale to nie je prázdna bunka!

Takže si to dorob, alebo sa nauč vkladať prílohu - hneď. Nerád robím zbytočnú prácu, ako v tomto prípade citovat

Martin12345678(21.10.2013 0:04)#015768

Popravdě jsem nečekal, že to bude takhle složitý kód, jaký jsi napsal. Myslel jsem, že jen něco málo doplníš do toho mého původního a pojede to. Proto jsem sem dodatečně vložil přílohu pro vyzkoušení. Kdybych tušil, že to bude takhle náročný, tak jsem jí sem dal hned. Tak se nezlobcitovat

AL(21.10.2013 0:12)#015770

No, a okrem toho sa mi zdá, že do toho listu Nabídka by si potreboval skopírovať z listu Nabídka_im i hodnoty zo stĺpcov C-L a to teda z toho tvojho pôvodného kódu úplne zrejmé tiež nebolo. Takže, ako hovorím, z mojej strane minimálne hodina v podstate úplne zbytočnej práce... Aspoň som si ošahal error handling, bohužiaľ pre teba, iba na príklade, ktorý som si pre potrebu kódu vytvoril sám, páč vzor, v ktorom si to potreboval poriešiť, si nedal a zadanie bolo nepresné...citovat

Martin12345678(21.10.2013 0:20)#015771

Potřebuji překopírovat více sloupců.Mě šlo jen o vyřešní jednoho sloupce pač zbytek už bych si dle vzoru dodělal.
Popravdě se v tom kódu vůbec neorientuji, ale všiml jsem si, že tam není ukončení oblasti pro kopírování buněk...start je jasný B24, ale jak je tam vyřešen konec oblasti z které se kopíruje (B24:B373 (v příkladu je konec na B124))?citovat

Strana:  1 2 3   další »

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse