Excel tábla egy oszlopba rendezés
2021-08-23T07:40:59+02:00
2021-08-24T15:04:07+02:00
2022-08-12T04:10:30+02:00
Eszta
Sziasztok,

Az alábbi problémával kapcsolatban lenne szükségem segítségre.

Adott egy B oszlopban lévő típusok mellette a többi oszlopban 1-31-ig a hónap napjainak sorszáma a típusokhoz tartozó mennyiségekkel.

Szeretném úgy listázni egy külön munkalapra, hogy a B oszlop mindig megjelenik mellette az 1-jéhez tartozó mennyiségek.
Majd alatta újra a B oszlop típusok és a 2-a mennyiségei.
Ez ismétlődne 31-ig.

Egyelőre csak egymás alá tudok listázni mindent...

Köszönöm előre is a segítséget.

//
Sub egyoszlop()

   Dim oszlop As Integer, uoszlop As Integer, usorA As Long, usorO As Long
   Dim WSI As Worksheet, WSV As Worksheet
   
   Set WSI = Sheets("eredeti")
   Set WSV = Sheets("oszlop")
   WSI.Activate
   uoszlop = WSI.UsedRange.Columns.Count
   
   For oszlop = 2 To uoszlop
      If Application.WorksheetFunction.CountA(WSI.Columns(oszlop)) > 0 Then
         usorO = WSI.Cells(Rows.Count, oszlop).End(xlUp).Row
         usorA = WSV.Cells(Rows.Count, 1).End(xlUp).Row + 1
         If usorA = 2 Then usorA = 1
         WSI.Range(Cells(1, oszlop), Cells(usorO, oszlop)).Copy WSV.Range("A" & usorA)
      End If
   Next
End Sub
Mutasd a teljes hozzászólást!
Szia,

Csatoltam végül sikerült kiszenvednem. Megcsinálja amit szeretnék.

bemásolom azért mire jutottam, nem biztos, hogy a legelegánsabb megoldás

'cikkszam masolas

    Dim oszlopC As Integer, uoszlopC As Integer, usorAC As Long, usorOC As Long
    
   For oszlopC = 1 To 120
      If Application.WorksheetFunction.CountA(WSI.Columns(oszlopC)) > 1 Then
         usorOC = WSI.Cells(Rows.Count, oszlopC).End(xlUp).Row
         usorAC = WSV.Cells(Rows.Count, 1).End(xlUp).Row + 1
         If usorAC = 2 Then usorAC = 1
         WSI.Range(Cells(1, 2), Cells(usorOC, 2)).Copy WSV.Range("A" & usorAC)
         
      End If
   Next
   
   
   
 'napok oszlopainak listazasa
 
   For oszlop = 3 To uoszlop
      If Application.WorksheetFunction.CountA(WSI.Columns(oszlop)) > 1 Then
         usorO = WSI.Cells(Rows.Count, oszlop).End(xlUp).Row
         usorA = WSV.Cells(Rows.Count, 2).End(xlUp).Row + 1
         If usorA = 2 Then usorA = 1
         WSI.Range(Cells(1, oszlop), Cells(usorO, oszlop)).Copy WSV.Range("B" & usorA)
         
      End If
   Next
Mutasd a teljes hozzászólást!
Csatolt állomány

  • szia, 

    nem derül ki számomra, a leveledből, hogy mi az ami nem működik, de 
    a Range sejtésem szerint egybefüggő területet jelöl be (itt mindenképpen), és neked már 1.e után nem lesz egybefüggő a területed

    tahát 2 lépcsőben kellene kiemelned a cuccot, azaz először a tipust, majd a naphoz tartozó éréket

    WSI.Range(Cells(1, 1), Cells(usorO, 1)).Copy WSV.Range("A" & usorA)
    WSI.Range(Cells(1, oszlop), Cells(usorO, oszlop)).Copy WSV.Range("A" & usorA)
    Mutasd a teljes hozzászólást!
  • Szia, 
    Ott akadok meg, hogy a típust nem tudom többször listázni.. próbáltam utolsó üres cella vizsgálattal, de mindig megakad
    Mutasd a teljes hozzászólást!
  • Szia!

    Lehet jobb lenne egy példa-munkalapot látni (ha érzékenyek az adatok akkor értelem szerűen más értékekkel feltöltve) hogy miből mit szeretnél csinálni.
    (ha jól értem akkor a B-oszlopban van a típus, a C-oszloptól meg indul, hogy hányadikán mennyi darab kell, majd a következő sor ugyan ez, csak következő hónap, viszont a cél munkalapra mit szeretnél, azt nem nagyon értem.)
    Mutasd a teljes hozzászólást!
  • Szia,

    Csatoltam végül sikerült kiszenvednem. Megcsinálja amit szeretnék.

    bemásolom azért mire jutottam, nem biztos, hogy a legelegánsabb megoldás

    'cikkszam masolas

        Dim oszlopC As Integer, uoszlopC As Integer, usorAC As Long, usorOC As Long
        
       For oszlopC = 1 To 120
          If Application.WorksheetFunction.CountA(WSI.Columns(oszlopC)) > 1 Then
             usorOC = WSI.Cells(Rows.Count, oszlopC).End(xlUp).Row
             usorAC = WSV.Cells(Rows.Count, 1).End(xlUp).Row + 1
             If usorAC = 2 Then usorAC = 1
             WSI.Range(Cells(1, 2), Cells(usorOC, 2)).Copy WSV.Range("A" & usorAC)
             
          End If
       Next
       
       
       
     'napok oszlopainak listazasa
     
       For oszlop = 3 To uoszlop
          If Application.WorksheetFunction.CountA(WSI.Columns(oszlop)) > 1 Then
             usorO = WSI.Cells(Rows.Count, oszlop).End(xlUp).Row
             usorA = WSV.Cells(Rows.Count, 2).End(xlUp).Row + 1
             If usorA = 2 Then usorA = 1
             WSI.Range(Cells(1, oszlop), Cells(usorO, oszlop)).Copy WSV.Range("B" & usorA)
             
          End If
       Next
    Mutasd a teljes hozzászólást!
    Csatolt állomány
  • Az az igazság, hogy ehhez ma már ehhez nem kell makró.
    PowerQuery integrálva van (talán 2019-től) és ezzel kell ilyen transzformációkat végrehajtani. Én legalábbis csak és kizárólag ezzel csinálok minden ehhez hasonlót.
    Egy példa két képpel illusztrálva (melléklet)

    És ezt csak frissíteni kell jobbklikkes menüből, ha a mögöttes halmaz változik.

    A feldolgozandó tartományt táblázattá kell alakítani.
    Mutasd a teljes hozzászólást!
    Csatolt állomány
  • ha megoldottad, akkor fogadd el a megoldásod megoldásként, ne maradjon nyitva a kérdés

    Így már érthető, hogy mit szeretnél. Általában mindig többféle megvalósítás lehetséges. Ha működik, akkor jó. Az ilyen apró lépésekből lehet tanulni rendesen, csak így tovább.
    Mutasd a teljes hozzászólást!
abcd