Hirdetés

  2. Fórumok
  3. OS, alkalmazások
  4. Microsoft Excel topic
  5. (kiemelt téma)
Legfrissebb anyagok
Keresés
  • Téma összefoglaló
    Utoljára frissítve: 2023-11-13 08:31

    LOGOUT

    A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
    Kérdés felvetése előtt olvasd el, ha még nem tetted.

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

  • #43225 Mutt senior tag Sesy #43217
    Új Válasz #43225
    Ú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 #43217 üzenetére

    Szia,

    VBA-s megoldást kaptál, de mivel Office365-öd van egy másik megoldás is, ami az új makró nyelvet használja.

    1. Telepítsd az Office áruházból a Script Lab bővítményt.
    2. Kattints a Scrip Lab menűben a Code gombra.

    3. A hamburger menüben válaszd az Import opciót és add meg ezt a linket: https://gist.github.com/viszi/e2bd0fe97f1cd3794ea2402c90d40914
    4. Betöltés után kattints a Run -> Run in this pane-re (feltéve ha már megnyitottad az átalakítandó fájlt).
    Majd pedig az indítás gombra.

    Ebben a változatban én meghagytam a díjak mértékegységét, ha nincs rá szükséged akkor a Code gomb alatt a 23-as sort (cel.getCell(i, 2).values = result[0][2];) töröld ki.

    Remélem nálad is műkődik.

    üdv

  • #43219 Delila_1 veterán Sesy #43217
    Új Válasz #43219
    Ú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

    Delila_1

    veterán

    válasz Sesy #43217 üzenetére

    Vegyél fel az 1.xlsx-ben egy új lapot, Munka2 néven.
    Modulba tedd a makrót, és indíthatod.
    A füzetet makróbarátként kell elmentened, ha máskor is akarod futtatni.

    Sub Elrendezes()
    Dim sor As Long, usor As Long
    Dim WS1 As Worksheet, WS2 As Worksheet

    Application.ScreenUpdating = False

    Set WS1 = Sheets("Munka1")
    Set WS2 = Sheets("Munka2")
    usor = WS1.Range("A" & Rows.Count).End(xlUp).Row

    For sor = 1 To usor
    If InStr(WS1.Cells(sor, 1), ":") > 0 And InStr(WS1.Cells(sor, 1), "Cikkszám") = 0 Then
    WS2.Cells(sor, 1) = Left(WS1.Cells(sor, 1), InStr(WS1.Cells(sor, 1), ":"))
    WS2.Cells(sor, 2) = Mid(WS1.Cells(sor, 1), InStr(WS1.Cells(sor, 1), ":") + 1, 70)
    Else
    WS2.Cells(sor, 1) = WS1.Cells(sor, 1)
    End If
    WS1.Cells(sor, 1).Copy
    WS2.Range("A" & sor & ":B" & sor).PasteSpecial xlPasteFormats
    Next
    WS2.Cells.Replace What:=" Ft/m2", Replacement:=""
    WS2.Cells.Replace What:=" Ft/óra", Replacement:=""
    WS2.Columns("A:A").ColumnWidth = 13.71

    Application.ScreenUpdating = True
    End Sub

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