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

• Delila_1 veterán

  #47125

  #47121 MostaPista

  2021-07-19 09:09:49

  Új Válasz

  Ú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

  

  Delila_1

  veterán

  #47121 MostaPista

  Írtam hozzá egy makrót.
  Két lap kell a füzetedben. Legyen Eredeti a lap neve, ahol az eredeti táblád van, és legyen egy új lap Konvertált névvel.

  Sub Konverzio()
    Dim usor As Long, sor As Long, idoIn As String, idoOut
    
    Sheets("Konvertált").Select
    Cells = ""
    Sheets("Eredeti").Range("A:J").Copy Sheets("Konvertált").Cells(1)
    Columns("A:A").Delete
    
     
    Range("A2:I2").Cut Destination:=Range("J1")
    Range("E1") = "Tim In 1"
    Range("F1") = "Tim In 2"
    Range("N1") = "Tim Out 1"
    Range("O1") = "Tim Out 2"
    usor = Range("A" & Rows.Count).End(xlUp).Row
    For sor = usor To 3 Step -2
        Range("A" & sor & ":I" & sor).Cut Destination:=Range("J" & sor - 1)
        Cells(sor, 1) = Cells(sor, 1) & ""
        idoIn = Cells(sor - 1, 5): idoOut = Cells(sor - 1, 14)
        Cells(sor - 1, "E") = Left(idoIn, InStr(idoIn, " ") - 1)
        Cells(sor - 1, "F") = Mid(idoIn, InStr(idoIn, " ") + 1, Len(idoIn))
        Cells(sor - 1, "N") = Left(idoOut, InStr(idoOut, " ") - 1)
        Cells(sor - 1, "O") = Mid(idoOut, InStr(idoOut, " ") + 1, Len(idoOut))
            
        Rows(sor).Delete Shift:=xlUp
    Next
    Rows(2).Delete Shift:=xlUp
    Range("B:B,D:D,G:H,K:K,M:M,Q:Q").Delete Shift:=xlToLeft
    Columns("A:K").EntireColumn.AutoFit
End Sub

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