Keresés

Hirdetés

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

  • lcdtv

    aktív tag

    válasz Teejay83 #39033 üzenetére

    Nekem is kellett ilyen de kicsit másképp. Szerintem tudod használni. Ez azt csinálja hogy pl. A oszlop az mindig egy fix szöveg a B oszlopba vannak a vesszővel szeparált szövegek, és a D oszlopba szétszedi őket egymás alá de a fix szöveggel együtt.
    Sub vesszovel_szetszedett()
    Dim rng As Range, Lstrw As Long, c As Range
    Dim SpltRng As Range
    Dim i As Integer
    Dim Orig As Variant
    Dim txt As String

    Lstrw = Cells(Rows.Count, "A").End(xlUp).Row
    Set rng = Range("A2:A" & Lstrw)

    For Each c In rng.Cells
    Set SpltRng = c.Offset(, 1)
    txt = SpltRng.Value
    Orig = Split(txt, ",")

    For i = 0 To UBound(Orig)
    Cells(Rows.Count, "D").End(xlUp).Offset(1) = c
    Cells(Rows.Count, "D").End(xlUp).Offset(, 1) = Orig(i)
    Next i

    Next c

    End Sub

    A kód elindítása után így néz ki.

  • Delila_1

    Topikgazda

    válasz Teejay83 #39033 üzenetére

    Ha csak 1 ilyen sorod van, az Adatok | Szövegből oszlopok menüponttal egymás mellé írathatod az egyes tagokat, majd a másolás, irányított beillesztés, transzformálva menüponttal egymás alá rendezheted a szétválasztott adatokat.

    Több sornál futtathatod a lenti makrót.

    Sub trans()
    Dim sor As Long, usor As Long, ide As Long
    Dim szoveg As String, hossz As Integer

    usor = Range("A" & Rows.Count).End(xlUp).Row
    ide = 1
    For sor = 1 To usor
    szoveg = Cells(sor, 1)
    Do While InStr(szoveg, ",") > 0
    hossz = InStr(szoveg, ",")
    Cells(ide, "B") = Left(szoveg, hossz - 1)
    szoveg = Mid(szoveg, hossz + 1, 100)
    ide = ide + 1
    Loop
    Cells(ide, "B") = szoveg
    ide = ide + 1
    Next
    End Sub

    Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.

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