< 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:  « předchozí  1 2 3   další »
icon #015772
avatar
V mojom kóde to určuje LastCell, ale tebe to je na draka, páč ja som vychádzal len zo zadania, ktoré si dal a kde som si pár vecí musel domyslieť - špatne. Písal si totiž, že chceš kopírovať neprázdne bunky z oblasti B24 až dolu, teraz píšeš po B124, ale neprázdne bunky sú i B125-B129, B131 a B137, ako hovorím, líná huba, holé neštěstí 7

miestoSet LastCell = .Cells(.Rows.Count, "B")by za norálnych okolností stačilo napísať:Set LastCell = .[B124]bohužiaľ, zostáva tu problém, že si zmieňoval neprázdne bunky a neuvedomil si, že bunka s hodnotou "" nie je neprázdnou bunkou..citovat
#015773
avatar
To je pravda, ta informace mě určitě nepomůže.
Zapoměl jsem to zmínit do textu, ale vycházel jsem z toho, že dojde ke změně mého kódu a tam je oblast definována:-(citovat
icon #015775
avatar
Mno, síce zmršené, páč sa mi nechce to tvoriť úplne od začiatku, ale snáď funkčné (som zvedavý, za čo môžem tentokrát):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 = .[B124]
If IsEmpty(LastCell) Then Set LastCell = LastCell.End(xlUp)
Set SourceRange = Range(FirstCell, LastCell)
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 Len(cell) > 0 Then
If SourceRangeToCopy Is Nothing Then
Set SourceRangeToCopy = cell
Else: Set SourceRangeToCopy = Union(cell, SourceRangeToCopy)
End If
End If
End If
Next cell
End With
Label1:
Set FirstCell = Nothing
Set LastCell = Nothing
Set SourceRange = Nothing
Set SourceRangeToLeave = Nothing
Set cell = Nothing
If Not SourceRangeToCopy Is Nothing Then
SourceRangeToCopy.Copy
Sheets("Nabídka").[B24].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
Set SourceRangeToCopy = Nothing

ErrHandler:
If Err.Number = 1004 Then
Set SourceRangeToCopy = Nothing
For Each cell In SourceRange.Cells
If Len(cell) > 0 Then
If SourceRangeToCopy Is Nothing Then
Set SourceRangeToCopy = cell
Else: Set SourceRangeToCopy = Union(cell, SourceRangeToCopy)
End If
End If
Next cell
Resume Label1
End If
End Sub
citovat
#015776
avatar
Obdivuji tvojí trpělivost a děkuji.
Ale pořád tam zlobí toto (error 1004)Set SourceRange = Range(FirstCell, LastCell)citovat
icon #015777
avatar
Tak to neviem...
Stiahol som si tvoj súbor, vložil doňho modul, nakopíroval kód a žiadny error to nehádže. Skopíruje bunky B24-B34 z listu Nabídka_im do listu Nabídkacitovat
#015778
avatar
No nevím co tam dělám blbě, ale error je přítomen stále:-(. Zkus se mrknout zda ti to půjde
Příloha: rar15778_databaze.rar (89kB, staženo 13x)
citovat
icon #015779
avatar
Problém je v tom, že z tlačítka voláš makro, ktoré si umiestnil do kódového okna listu, nie do modulu, ach jo 7
V takom prípade, pokiaľ sa odkazuješ na iné listy, musíš pri adresovaní používať tzv. full qualifying, t.j. uvádzanie názvov listov, na ktoré v kóde odkazuješ.
Nejaký dôvod, prečo je to tlačítko ActiveX objekt miesto normálneho command buttonu? No nič, nechám toho.

Vyriešiš nasledovne.
Tlačítku priradíš kód:
Private Sub CommandButton3_Click()
Call SkopirujNeprazdneHodnoty
End Sub

A kód SkopirujNeprazdneHodnoty umiestniš do modulu, nie do kódového okna Listu!citovat
#015793
avatar
Díky moc, teď to jde perfektně.
Jinak jak tak koukám mě docela slušně chybí základy ohledně kódu a maker, musím na tom zapracovat. Nenapadlo mě to dát do modulu. Zase jsem chytřejší.
Ještě jednou moc děkuji...citovat
icon #015794
avatar
njn, potrápil si ma trochu, ale nakoniec to predsa len k niečomu bolo 1citovat
#015803
avatar
No tak mě si vytrhl trn z paty už po několikáté a to potrápení opravdu nebylo úmyslné:-)citovat

Strana:  « předchozí  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