Hirdetés

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

    PROHARDVER!

    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

  • #38863 Fferi50 Topikgazda GreenIT #38859
    Új Válasz #38863
    Ú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

    Fferi50

    Topikgazda

    válasz GreenIT #38859 üzenetére

    Szia!

    Próbáld ki ezt a makrót:
    Sub Makró1()
    '
    ' Összesítés
    Dim ws As Worksheet, uszlp As Integer, wso As Worksheet, wss
    Set wss = Sheets(Array("Munka1", "Munka2", "Munka3"))
    wss.Copy after:=Sheets(Sheets.Count)
    For Each ws In wss
    With ws
    uszlp = .Range("A1").End(xlToRight).Column
    .Rows(2).Insert shift:=xlDown
    With .Range(.Cells(2, 2), .Cells(2, uszlp))
    .Formula = "=RIGHT(""000""&COLUMN(),3)&B1&$A$1"
    .Value = .Value
    End With
    .Rows(1).Delete shift:=xlUp
    End With
    Next
    Set wso = Sheets.Add(after:=Sheets(3))
    wso.Name = "MunkaÖ (S)"
    Selection.Consolidate Sources:=Array(Sheets("Munka1").Range("A1").CurrentRegion.Address(external:=True, ReferenceStyle:=xlR1C1), _
    Sheets("Munka2").Range("A1").CurrentRegion.Address(external:=True, ReferenceStyle:=xlR1C1), Sheets("Munka3").Range("A1").CurrentRegion.Address(external:=True, ReferenceStyle:=xlR1C1)), Function:= _
    xlSum, TopRow:=True, LeftColumn:=True, CreateLinks:=False
    Range("A1").CurrentRegion.Offset(0, 1).Sort key1:=Rows(1), order1:=xlAscending, Orientation:=xlSortRows, Header:=xlYes
    With wso
    uszlp = .Range("B1").End(xlToRight).Column
    .Rows(2).Insert shift:=xlDown
    .Range(.Cells(2, 2), .Cells(2, uszlp)).Formula = "=MID(B1,4,LEN(B1)-4)"
    .Range(.Cells(2, 2), .Cells(2, uszlp)).Value = .Range(.Cells(2, 2), .Cells(2, uszlp)).Value
    .Rows(3).Insert shift:=xlDown
    .Range(.Cells(3, 2), .Cells(3, uszlp)).Formula = "=right(B1,1)"
    .Range(.Cells(3, 2), .Cells(3, uszlp)).Value = .Range(.Cells(3, 2), .Cells(3, uszlp)).Value
    .Rows(1).Delete shift:=xlUp
    .Range("A1").Value = "M"
    End With
    For Each ws In Sheets
    If InStr(ws.Name, "(") = 0 Then
    ws.Delete
    Else
    ws.Name = Left(ws.Name, InStr(ws.Name, "(") - 2)
    End If
    Next
    End Sub
    A munkanap nevek helyére írd a nálad levő neveket. Csak ez a három munkalap legyen indulóban a munkafüzetben.

    Üdv.

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