MS Excel

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ší »

AL(21.10.2013 0:28)#015772

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í

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

Martin12345678(21.10.2013 0:33)#015773

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

AL(21.10.2013 1:09)#015775

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 Subcitovat

Martin12345678(21.10.2013 1:20)#015776

Obdivuji tvojí trpělivost a děkuji.
Ale pořád tam zlobí toto (error 1004)Set SourceRange = Range(FirstCell, LastCell)citovat

AL(21.10.2013 1:28)#015777

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

Martin12345678(21.10.2013 1:36)#015778

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: rar

15778_databaze.rar (89kB, staženo 13x)

citovat

AL(21.10.2013 1:52)#015779

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

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

Martin12345678(21.10.2013 11:33)#015793

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

AL(21.10.2013 11:38)#015794

njn, potrápil si ma trochu, ale nakoniec to predsa len k niečomu bolo

citovat

Martin12345678(21.10.2013 17:11)#015803

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ší »

Téma: Kopie dat z buňěk

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje