< návrat zpět

MS Excel


Téma: Kopie dat z buňěk rss

Zaslal/a 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ší »
icon #015754
avatar
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
#015755
avatar
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
icon #015756
avatar
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 1 .

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 Sub
citovat
icon #015757
avatar
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 1 ):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 Sub
citovat
#015762
avatar
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
#015764
avatar
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: rar15764_databaze.rar (89kB, staženo 16x)
citovat
icon #015766
avatar
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 7
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 6citovat
#015768
avatar
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
icon #015770
avatar
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
#015771
avatar
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)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

rozpis zápasů hráčů pro utkání dvou týmů

Anonym • 25.5. 11:54

Hromadné přepsání

elninoslov • 24.5. 10:29

Hromadné přepsání

Nomi • 24.5. 8:32

Index - každý rok začít od 1 Power Query

Alfan • 23.5. 9:17

nepřímý odkaz

elninoslov • 23.5. 0:00

nepřímý odkaz

bordov • 22.5. 18:35

vrácené hodnoty

Anonym • 22.5. 15:46