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
10 bejegyzés megtekintése - 1-10 / 10
  • Szerző
    Bejegyzés
  • 2021-01-14-15:04 #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
      2021-01-14-15:06 #8129
      pexcel
      Felhasználó

        Valamiért a csatolmány lemaradt.

        Attachments:
        You must be logged in to view attached files.
        2021-01-14-15:51 #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

          2021-01-14-17:33 #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

            2021-01-14-19:26 #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.

              2021-01-15-08:02 #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

                2021-01-15-09:04 #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

                  2021-01-15-10:18 #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

                    2021-01-15-10:33 #8138
                    horvimi
                    Adminisztrátor

                      Örülönk 🙂

                      2021-01-16-08:45 #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

                      • Szerző
                        Bejegyzés
                      10 bejegyzés megtekintése - 1-10 / 10
                      • Be kell jelentkezni a hozzászóláshoz.