2. Fórumok
  3. OS, alkalmazások
  4. Microsoft Excel topic
  5. (kiemelt téma)

Hirdetés

100 000 érv a ReGalaxy mellett: Vásárolj Galaxy Z Fold7 I Z Flip7 vagy Galaxy S25 szériás készüléket, és régi mobilod felújítását 100 000 Ft-ig mi álljuk!
  • Téma összefoglaló
    Utoljára frissítve: 2023-11-13 08:31

    Mobilarena

    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

  • #43228 Delila_1 veterán Sesy #43224
    Új Válasz #43228
    Ú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 #43224 üzenetére

    Itt van magyarázatokkal a makró.

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

    Application.ScreenUpdating = False 'képernyő frissítés leállítása, gyorsabb végrehajtás

    Set WS1 = Sheets("Munka1") 'innen kezdve a Sheets("Munka1") helyett elég WS1-et írni
    Set WS2 = Sheets("Munka2") 'innen kezdve a Sheets("Munka2") helyett elég WS2-et írni
    usor = WS1.Range("A" & Rows.Count).End(xlUp).Row 'alsó sor a Munka1 lapon

    For sor = 1 To usor
    'az InStr a szöveg.keres VBA-s változata
    'ha van a szövegben ":", de nem "Cikkszám:", akkor bontsa ketté a szöveget az A és B oszlopokba
    'a mintád 57. sorában
    ' "BAKONYTHERM 30 N+F belső teherhordó fal, 300x250x240 mm, I.o., Cikkszám:TÉG13 M 2,5 (Hf30-cm) falazó, meszes cementhabarcs"
    'szerepel, emiatt kellett a 2. feltételt berakni
    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) 'ha nincs ":", akkor a teljes szöveg az A-ba
    End If

    'formátum másolás Munka1-ről Munka2-re az A és B oszlopban a félkövér sorok miatt
    WS1.Cells(sor, 1).Copy
    WS2.Range("A" & sor & ":B" & sor).PasteSpecial xlPasteFormats
    Next
    'csere funkció, a " Ft/m2" és " Ft/óra" cseréje semmire
    WS2.Cells.Replace What:=" Ft/m2", Replacement:=""
    WS2.Cells.Replace What:=" Ft/óra", Replacement:=""

    WS2.Columns("A:A").ColumnWidth = 13.71 'az A oszlop kiszélesítése

    Application.ScreenUpdating = True 'képernyő frissítés engedélyezése
    End Sub

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