Új hozzászólás Aktív témák

• #54739 Mutt senior tag Sesy #54738

  Új Válasz 2025-11-14 07:13:27 #54739

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Mutt

  senior tag

  válasz Sesy #54738 üzenetére

  Szia,

  Kösz a pontosítást. Félreértelmeztem a dolgot, a makró ez esetben egyszerűbb mivel az első oszlopban van egy azonosító rész (a pont előtti), ami alapján egybe kell tenni az adatokat.

  A run-time error-t azért kapod, mert a makró úgy működik hogy előbb kijelölöd egérrel azt a részt ahol a bemeneti adatok vannak és utána indítod el.

  A Set adatsor = Intersect(Selection, ActiveSheet.UsedRange) részben a Selection jelenti az általad kijelölt tartományt, az Activesheet... pedig az összes tartományt jelenti ahol van adat. Ha fix helyen van a bementi adatod (pl. B1-es cellától indulva lefelé),
  akkor Set adatsor = Range("B1").CurrentRegion műkődik.

  Option Explicit
Sub Transzponalas()
    Dim adatsor As Range
    Dim adatok()
    
    'tegyük a kijelölt bemeneti adatokat egy tömbbe
    Set adatsor = Intersect(Selection, ActiveSheet.UsedRange)
    adatok = adatsor
    
    'kérdezzük meg hova kerüljön az eredmény
    Dim cel As Range
    Set cel = Application.InputBox(Prompt:="Add meg hova kerüljön az eredmény!", Title:="Információ", Type:=8).Range("A1")
    
    'nézzük meg nem írjuk-e felül a bemeneti tartományt
    If Not Intersect(adatsor, cel) Is Nothing Then
       Call MsgBox(Prompt:="A cél terület beleér a bemenő adatokat tartalmazó tartományba", Buttons:=vbOKOnly, Title:="Hiba")
       Exit Sub
    End If
    
    'ebbe a tömbbe fogjuk gyűjteni az eredményt
    Dim kimenet()
    ReDim kimenet(1 To 2)
    
    Dim x As Long
  Dim azonosito As String, fsplit
    Dim v_sor As Long
    
    v_sor = 0
    
    With cel.Parent
        For x = 1 To UBound(adatok, 1)
            'a legelőször látott értékeket eltároljuk
            If x = 1 Then
                kimenet(1) = adatok(x, 1)
                kimenet(2) = adatok(x, 2)
                
                'szakasz azonosító meghatározása referenciához
                fsplit = Split(kimenet(1), ".")
                azonosito = fsplit(0)
            Else
                'aktuális sorban keressük meg a szakasz azonosítót
                fsplit = Split(adatok(x, 1), ".")
                
                'ha azonos mint az előző, akkor
                '1) hozzáadjuk a kimeneti tömbhöz az értékeket
                If fsplit(0) = azonosito Then
                    ReDim Preserve kimenet(1 To UBound(kimenet) + 2)
                    kimenet(UBound(kimenet) - 1) = adatok(x, 1)
                    kimenet(UBound(kimenet) - 0) = adatok(x, 2)
                Else
                'ha nem azonos a szakasz azonosító, akkor
                '1) kiírjuk a "kimenet"-et
                '2) növeljük a sorszámot ahova az eredményeket tesszük
                '3) töröljük a "kimenet" tartalmát
                '4) elmentjük az új szakasz azonosítót
                    cel.Offset(v_sor).Resize(, UBound(kimenet)) = kimenet
                    
                    v_sor = v_sor + 1
                    
                    ReDim kimenet(1 To 2)
                    kimenet(1) = adatok(x, 1)
                    kimenet(2) = adatok(x, 2)
                    azonosito = fsplit(0)
                End If
            End If
        Next x
        
        'ha a ciklus végén maradt vmi a tömbben írjuk ki
        If kimenet(1) <> "" Then
            cel.Offset(v_sor).Resize(, UBound(kimenet)) = kimenet
        End If
    End With
    
End Sub

  MS365-ben vannak újabb függvények, amelyek tudnak segíteni.
  A képlet:
  =LET(adatok;A1:B20;
kodok;OSZLOPVÁLASZTÁS(adatok;1);
azonositok;EGYEDI(SZÖVEGELŐTTE(kodok;"."));
csoportok;REDUCE("";azonositok;LAMBDA(a;c;FÜGG.HALMOZÁS(a;SZÖVEGFELOSZTÁS(SZÖVEGÖSSZEFŰZÉS("|";IGAZ;SZŰRŐ(adatok;SZÖVEGELŐTTE(kodok;".")=c));"|"))));
HAHIBA(ELTÁVOLÍT(csoportok;1);""))
  
  Hogyan működik?
  1) LET-el változókat lehet a képletben létrehozni és azokkal műveleteket végezni. Az első paraméter a változó neve és utána egy művelet, pl. "adatok" a változó neve és utána a "A1 : B20" a tartomány ahonnan kellenek az adatok. A LET-ben az utolsó paraméter egy művelet, aminek az eredményét kiírja az Excel.
  2) Szóval bemeneti adatok első oszlopából csináltam egy listát, amely a pont előtti részeket visszaadja minden sorra ("F1-01", ... "F1-02"), és ebből csak az egyedi értékeket tartottam meg (ez kerül be az "azonositok" változóba).
  3) Ezek után a SZŰRŐ függvénnyel az eredeti adatsorból kinyerem az egyik azonosítóhoz tartozó értékeket. Az eredményt egy sorba kell tenni, itt jön az a trükk hogy előbb összefűzzük az elemeket egy cellába olyan elválasztó jellel, ami nincs az adatsorban, majd ezt ugyanezen elválasztó jel szerint feldaraboljuk. Belül van a SZÖVEGÖSSZEFŰZÉS ahol a "|" (pipe) jelet használtam elválasztónak, és kívül van a SZÖVEGFELOSZTÁS szintén pipe-al.
  4) A REDUCE függvény segít abban hogy a 3-as lépésben lévő szűrést mindegyik azonosítóval megcsináljam. Mindegyik szűrés eredményét egymásra teszem (függőleges halmozás).
  5) Csinosítani kell a végeredményt, mert nem minden sorban lesz ugyanannyi oszlop.

  üdv

Új hozzászólás Aktív témák