Telefonszámunk: 1-472-0679

[Resolved] VBA – Nem összefüggő range-ek másolása

Kezdőlap Fórumok Excel programozás [Resolved] VBA – Nem összefüggő range-ek másolása

Topic Resolution: Resolved

Ennek a témakörnek tartalma 9 hozzászólás, 3 résztvevő. Utolsó frissítés:  delila 1 hónap, 1 hét telt el.

10 bejegyzés megtekintése - 1-10 / 10
  • Szerző
    Bejegyzés
  • #8128

    pexcel
    Felhasználó

    Sziasztok,
    Először is szeretnék boldog új évet kívánni mindenkinek!
    A következőkben szeretném kérni a segítségeteket.
    Adott egy több mint 100 oszlopból álló tartomány, amelyben az első oszlop kivételével (amely egy dátum oszlop) két egymást követő oszlop logikailag összetartozik. Ezen két egymást követő oszlop tartalmát szeretném együttesen átmásolni egy másik sheet-re, azonban úgy, hogy az első oszlopból csak annak első három sora, a második oszlopból viszont minden sor átmásolásra kerül (mellékelten csatoltam egy mintát, ahol kijelöltem azokat a nem összefüggő tartományokat, amelyeket át kellene másolni egymás után).
    Arra gondoltam, hogy a for ciklusban egy tömbös megoldást alkalmazok, azonban sajnos nem tudom, hogy kell helyesen definiálni egy olyan range-et, amely két, nem összefüggő tartományból áll.
    Alább csatolom a rutint (elnézést, hogy külön a fájltól, sajnos nincs winzip-em), amelyben a ’rng1’ elnevezésű range definícióját kellene korrigálni úgy, hogy az tartalmazza a másik másolandó range-et is.
    Nem tudom, ez a helyes út-e a megvalósítás során, de nagyon hálás lennék, ha tudnátok segíteni.

    Köszönettel,
    Péter

    Az eddigi rutin:

    Sub proba()
    Dim myArray() As Variant
    Dim rng1 As Range
    ReDim myArray(0)
    
    lcol = Sheets("Copy").Cells(1, Columns.Count).End(xlToLeft).Column
    lRow = Sheets("Copy").Cells(Rows.Count, 1).End(xlUp).Row
    
    For j = 3 To lcol
    Sheets("Copy").Activate
    Set rng1 = Range(Cells(3, j), Cells(lRow, j))
    
     For Each cell In rng1.Cells
       myArray(UBound(myArray)) = cell.Value
        ReDim Preserve myArray(UBound(myArray) + 1)
      Next cell
    
    Sheets("Osszes").Activate
    For x = 1 To lcol
    
    ActiveSheet.Range(Cells(l, x), Cells(UBound(myArray), x)).Value = WorksheetFunction.Transpose(myArray)
    
    Next x
    
    Next j
    
    End Sub
    #8129

    pexcel
    Felhasználó

    Valamiért a csatolmány lemaradt.

    Attachments:
    You must be logged in to view attached files.
    #8131

    horvimi
    Adminisztrátor

    Szia!

    Elsőként a UNION függvényról.
    Ez arra való, hogy az argumentumokban definiált tartományokat egy közös selekcióba vonja.
    Ha beírod az Immediate ablakba ezt:

    union(range("d3:d5",)range("e3:e12")).select

    Akkor ki fogja jelölni mindkét tartományt.

    A copy parancs nem összefüggő tartományra hibát dob, szóval mást kell csinálni, végig kel menni egy ciklussal a kijelölés különálló területein.

    A selekcióban lett két un. area.
    Újabb parancs:

    ?selection.areas.count

    Ez 2-t fog adni, mert a nem összefüggő területek száma a kijelölésben kettő
    Az első lesz a selection.areas(1), a másik pedig a selection.areas(2)

    Mivel a copy/paste nem működik, Ezeket külön-külön kell kezelni, pl. berakhatnád egy-egy tömbbe őket, és ezután már tiéd a buli, oda teszed őket, ahová akarod.

    Imre

    #8132

    pexcel
    Felhasználó

    Szia Imre,
    Nagyon szépen köszönöm a gyors választ és a hasznos tanácsokat!
    A leírtak alapján egyetlen kérdésem volna még.
    Én a selection.areas(1)-t eltárolnám egy változóba (amely a ciklusban nyilván dinamikusan változik), ez mondjuk legyen ‘valt1’, míg a selection.areas(2)-t egy ‘valt2″ változóba, majd ezeket adnám át a tömbnek.
    Pl. array = (valt1, valt2) – itt nem tudom idézőlejek közé kell-e tenni a neveket.
    Ez ebben a formában működhet?

    Köszönöm,
    Péter

    #8133

    horvimi
    Adminisztrátor

    Arra gondolok, hogy tömb sem kell igazából.
    Ha csinálsz két Range típusú változót, (a és b) akkor csinálhatod velük ezt:

    set a = selection.areas(1)
    a.copy destination:=sheets(2).range("a1")

    Imre

    P.S
    Az eredeti kérdésre a válaszom az, hogy ha tömbökkel kezdesz, ami remek dolog, akkor ehhez is rengeteg anyagot találsz, csak jól kell keresni, ANGOLUL főleg. Például hogyan teszünk tartományt tömbbe, hogyan teszünk tömböt tartományba.
    Alapszabály, hogy változónevet SOHA nem teszünk idézőjelbe.

    #8134

    pexcel
    Felhasználó

    Szia Imre,

    Igen, elég sokat nézem a külföldi fórumokat ha valamire szüskségem van, de néha előfordul, hogy nem találom meg, amire szükségem van.
    Nagyon köszönöm a segítséget, sikerült közben megvalósítani mind az álatlad javasolt másolással, mind tömb segítségével. Illetve egyetlen utolsó kérdés.
    A tömb tartalmának új sheet-re töténő, dinamikus range-be beilesztése során azt a hibát dobja, hogy
    “Application-defined or Object-defined error”

    With ActiveSheet
    .Range(.Cells(l, j), .Cells(UBound(myArray), 1)) = WorksheetFunction.Transpose(myArray)
    End With

    Erre is rákerestem, és egy fóromun pont ezt a megvalósítást javasolták.
    Lenne ötleted, hogy mi a hiba?

    Péter

    #8135

    horvimi
    Adminisztrátor

    Csak Ennyiből nem fogom tudni, le kell debug-olni.
    Kérdés, hogy milyen értékek vannak a változókban, amikor megáll.

    A fenti kódból nem derül ki, hogy hová akarja pontosan betenni a tömböt, és mekkora az előre megadott tartomány.
    csak annyi biztos belőle, hogy az ActiveSheet.Cells(UBound(maArray),1) az A oszlop egyik cellája, ez lenne a tartomány vége.
    Az eleje az l és j változók aktuális értékétől függ, ahol j-nek szintán 1-nek kellene lennie, ha egy egyoszlopos tömböd van.

    Imre

    #8137

    pexcel
    Felhasználó

    Sikerült megoldani; valóban a j értékét kellett úgy állítanai, hogy az konzisztens legyen egy egydimenziós tömbbel.
    Nagyon köszönöm a sok segítséget!

    Péter

    #8138

    horvimi
    Adminisztrátor

    Örülönk 🙂

    #8140

    delila
    Felhasználó

    Szia!
    Tömbök, területek változóba tétele nélkül is meg lehet oldani.
    2 makrót írtam, mert nem derült ki, hogy a másik lapon egymás mellé, vagy alá akarod másolni az adatokat.

    Sub Masol_Munka1_re()   'egymás alá
        Dim oszlop As Integer, usor As Long, uoszlop As Integer, ide As Long
        usor = ActiveSheet.UsedRange.Rows.Count
        uoszlop = ActiveSheet.UsedRange.Columns.Count
        ide = 2
        For oszlop = 2 To uoszlop - 1 Step 2
            Range(Cells(2, oszlop), Cells(4, oszlop)).Copy Sheets("Munka1").Cells(ide, 1)
            Range(Cells(3, oszlop + 1), Cells(usor, oszlop + 1)).Copy Sheets("Munka1").Cells(ide + 1, 2)
            ide = Sheets("Munka1").Range("B" & Rows.Count).End(xlUp).Row + 1
        Next
    End Sub
    
    Sub Masol_Munka2_re()   'egymás mellé
        Dim oszlop As Integer, usor As Integer, uoszlop As Integer
        usor = ActiveSheet.UsedRange.Rows.Count
        uoszlop = ActiveSheet.UsedRange.Columns.Count
        For oszlop = 2 To uoszlop - 1 Step 2
            Range(Cells(2, oszlop), Cells(4, oszlop)).Copy Sheets("Munka2").Cells(2, oszlop - 1)
            Range(Cells(3, oszlop + 1), Cells(usor, oszlop + 1)).Copy Sheets("Munka2").Cells(3, oszlop)
        Next
    End Sub

    Delila

10 bejegyzés megtekintése - 1-10 / 10

Be kell jelentkezni a hozzászóláshoz.